Mercurial > emacs
comparison lisp/vc.el @ 12311:d33ef5819d81
(vc-register): Inhibit backups for the file's buffer
(vc-add-triple, vc-lookup-triple, vc-record-rename):
Use absolute file names to access the SCCS named configuration files
("VC-names").
(vc-retrieve-snapshot): Use vc-checkout instead of
vc-backend-checkout, as the former also updates the current buffer.
(vc-file-tree-walk, vc-file-tree-walk-internal): Use
expand-file-name, so that FUNC gets called with an unabbreviated name.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 19 Jun 1995 13:36:45 +0000 |
parents | ba3d2da14bca |
children | 8fecaa78ac4b |
comparison
equal
deleted
inserted
replaced
12310:afad1c3ce9bd | 12311:d33ef5819d81 |
---|---|
102 "*Display run messages from back-end commands.") | 102 "*Display run messages from back-end commands.") |
103 (defvar vc-checkin-switches nil | 103 (defvar vc-checkin-switches nil |
104 "*Extra switches passed to the checkin program by \\[vc-checkin].") | 104 "*Extra switches passed to the checkin program by \\[vc-checkin].") |
105 (defvar vc-checkout-switches nil | 105 (defvar vc-checkout-switches nil |
106 "*Extra switches passed to the checkout program by \\[vc-checkout].") | 106 "*Extra switches passed to the checkout program by \\[vc-checkout].") |
107 (defvar vc-directory-exclusion-list '("SCCS" "RCS") | 107 (defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS") |
108 "*Directory names ignored by functions that recursively walk file trees.") | 108 "*Directory names ignored by functions that recursively walk file trees.") |
109 | 109 |
110 (defconst vc-maximum-comment-ring-size 32 | 110 (defconst vc-maximum-comment-ring-size 32 |
111 "Maximum number of saved comments in the comment ring.") | 111 "Maximum number of saved comments in the comment ring.") |
112 | 112 |
291 (setq squeezed (append squeezed (list file))))) | 291 (setq squeezed (append squeezed (list file))))) |
292 (let ((exec-path (append vc-path exec-path)) | 292 (let ((exec-path (append vc-path exec-path)) |
293 ;; Add vc-path to PATH for the execution of this command. | 293 ;; Add vc-path to PATH for the execution of this command. |
294 (process-environment | 294 (process-environment |
295 (cons (concat "PATH=" (getenv "PATH") | 295 (cons (concat "PATH=" (getenv "PATH") |
296 ":" (mapconcat 'identity vc-path ":")) | 296 path-separator |
297 (mapconcat 'identity vc-path path-separator)) | |
297 process-environment))) | 298 process-environment))) |
298 (setq status (apply 'call-process command nil t nil squeezed))) | 299 (setq status (apply 'call-process command nil t nil squeezed))) |
299 (goto-char (point-max)) | 300 (goto-char (point-max)) |
300 (set-buffer-modified-p nil) | 301 (set-buffer-modified-p nil) |
301 (forward-line -1) | 302 (forward-line -1) |
661 (if (and (not (buffer-modified-p)) | 662 (if (and (not (buffer-modified-p)) |
662 (zerop (buffer-size)) | 663 (zerop (buffer-size)) |
663 (not (file-exists-p buffer-file-name))) | 664 (not (file-exists-p buffer-file-name))) |
664 (set-buffer-modified-p t)) | 665 (set-buffer-modified-p t)) |
665 (vc-buffer-sync) | 666 (vc-buffer-sync) |
667 (cond ((not vc-make-backup-files) | |
668 ;; inhibit backup for this buffer | |
669 (make-local-variable 'backup-inhibited) | |
670 (setq backup-inhibited t))) | |
666 (vc-admin | 671 (vc-admin |
667 buffer-file-name | 672 buffer-file-name |
668 (and override | 673 (and override |
669 (read-string | 674 (read-string |
670 (format "Initial version level for %s: " buffer-file-name)))) | 675 (format "Initial version level for %s: " buffer-file-name)))) |
1133 "Show version-control status of the current directory and subdirectories. | 1138 "Show version-control status of the current directory and subdirectories. |
1134 Normally it creates a Dired buffer that lists only the locked files | 1139 Normally it creates a Dired buffer that lists only the locked files |
1135 in all these directories. With a prefix argument, it lists all files." | 1140 in all these directories. With a prefix argument, it lists all files." |
1136 (interactive "P") | 1141 (interactive "P") |
1137 (let (nonempty | 1142 (let (nonempty |
1138 (dl (length default-directory)) | 1143 (dl (length (expand-file-name default-directory))) |
1139 (filelist nil) (userlist nil) | 1144 (filelist nil) (userlist nil) |
1140 dired-buf | 1145 dired-buf |
1141 dired-buf-mod-count) | 1146 dired-buf-mod-count) |
1142 (vc-file-tree-walk | 1147 (vc-file-tree-walk |
1143 (function (lambda (f) | 1148 (function (lambda (f) |
1207 | 1212 |
1208 ;; Named-configuration support for SCCS | 1213 ;; Named-configuration support for SCCS |
1209 | 1214 |
1210 (defun vc-add-triple (name file rev) | 1215 (defun vc-add-triple (name file rev) |
1211 (save-excursion | 1216 (save-excursion |
1212 (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)) | 1217 (find-file (expand-file-name |
1218 vc-name-assoc-file | |
1219 (file-name-as-directory | |
1220 (expand-file-name (vc-backend-subdirectory-name file) | |
1221 (file-name-directory file))))) | |
1213 (goto-char (point-max)) | 1222 (goto-char (point-max)) |
1214 (insert name "\t:\t" file "\t" rev "\n") | 1223 (insert name "\t:\t" file "\t" rev "\n") |
1215 (basic-save-buffer) | 1224 (basic-save-buffer) |
1216 (kill-buffer (current-buffer)) | 1225 (kill-buffer (current-buffer)) |
1217 )) | 1226 )) |
1218 | 1227 |
1219 (defun vc-record-rename (file newname) | 1228 (defun vc-record-rename (file newname) |
1220 (save-excursion | 1229 (save-excursion |
1221 (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)) | 1230 (find-file |
1231 (expand-file-name | |
1232 vc-name-assoc-file | |
1233 (file-name-as-directory | |
1234 (expand-file-name (vc-backend-subdirectory-name file) | |
1235 (file-name-directory file))))) | |
1222 (goto-char (point-min)) | 1236 (goto-char (point-min)) |
1223 ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) | 1237 ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) |
1224 (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t) | 1238 (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t) |
1225 (replace-match (concat ":" newname) nil nil)) | 1239 (replace-match (concat ":" newname) nil nil)) |
1226 (basic-save-buffer) | 1240 (basic-save-buffer) |
1235 (and (>= firstchar ?0) (<= firstchar ?9))) | 1249 (and (>= firstchar ?0) (<= firstchar ?9))) |
1236 name) | 1250 name) |
1237 (t | 1251 (t |
1238 (save-excursion | 1252 (save-excursion |
1239 (set-buffer (get-buffer-create "*vc-info*")) | 1253 (set-buffer (get-buffer-create "*vc-info*")) |
1240 (vc-insert-file (concat | 1254 (vc-insert-file |
1241 (vc-backend-subdirectory-name file) | 1255 (expand-file-name |
1242 "/" vc-name-assoc-file)) | 1256 vc-name-assoc-file |
1257 (file-name-as-directory | |
1258 (expand-file-name (vc-backend-subdirectory-name file) | |
1259 (file-name-directory file))))) | |
1243 (prog1 | 1260 (prog1 |
1244 (car (vc-parse-buffer | 1261 (car (vc-parse-buffer |
1245 (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1)))) | 1262 (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1)))) |
1246 (kill-buffer "*vc-info*")))) | 1263 (kill-buffer "*vc-info*")))) |
1247 )) | 1264 )) |
1286 (error "File %s is locked" locked) | 1303 (error "File %s is locked" locked) |
1287 (vc-file-tree-walk | 1304 (vc-file-tree-walk |
1288 (function (lambda (f) (and | 1305 (function (lambda (f) (and |
1289 (vc-name f) | 1306 (vc-name f) |
1290 (vc-error-occurred | 1307 (vc-error-occurred |
1291 (vc-backend-checkout f nil name)))))) | 1308 (vc-checkout f nil name)))))) |
1292 ))) | 1309 ))) |
1293 | 1310 |
1294 ;; Miscellaneous other entry points | 1311 ;; Miscellaneous other entry points |
1295 | 1312 |
1296 ;;;###autoload | 1313 ;;;###autoload |
1984 ;;; These things should probably be generally available | 2001 ;;; These things should probably be generally available |
1985 | 2002 |
1986 (defun vc-file-tree-walk (func &rest args) | 2003 (defun vc-file-tree-walk (func &rest args) |
1987 "Walk recursively through default directory. | 2004 "Walk recursively through default directory. |
1988 Invoke FUNC f ARGS on each non-directory file f underneath it." | 2005 Invoke FUNC f ARGS on each non-directory file f underneath it." |
1989 (vc-file-tree-walk-internal default-directory func args) | 2006 (vc-file-tree-walk-internal (expand-file-name default-directory) func args) |
1990 (message "Traversing directory %s...done" default-directory)) | 2007 (message "Traversing directory %s...done" default-directory)) |
1991 | 2008 |
1992 (defun vc-file-tree-walk-internal (file func args) | 2009 (defun vc-file-tree-walk-internal (file func args) |
1993 (if (not (file-directory-p file)) | 2010 (if (not (file-directory-p file)) |
1994 (apply func file args) | 2011 (apply func file args) |
1995 (message "Traversing directory %s..." file) | 2012 (message "Traversing directory %s..." (abbreviate-file-name file)) |
1996 (let ((dir (file-name-as-directory file))) | 2013 (let ((dir (file-name-as-directory file))) |
1997 (mapcar | 2014 (mapcar |
1998 (function | 2015 (function |
1999 (lambda (f) (or | 2016 (lambda (f) (or |
2000 (string-equal f ".") | 2017 (string-equal f ".") |