Mercurial > emacs
comparison lisp/vc-sccs.el @ 35134:f7a5d39c26f0
(vc-sccs-latest-on-branch-p): Removed.
(vc-sccs-checkout, vc-sccs-cancel-version): Renamed arg WRITABLE to EDITABLE.
| author | André Spiegel <spiegel@gnu.org> |
|---|---|
| date | Mon, 08 Jan 2001 16:26:44 +0000 |
| parents | da206bbad86b |
| children | 1b423e7eb1eb |
comparison
equal
deleted
inserted
replaced
| 35133:1b45907ef7a8 | 35134:f7a5d39c26f0 |
|---|---|
| 3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc. |
| 4 | 4 |
| 5 ;; Author: FSF (see vc.el for full credits) | 5 ;; Author: FSF (see vc.el for full credits) |
| 6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> | 6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
| 7 | 7 |
| 8 ;; $Id: vc-sccs.el,v 1.4 2000/09/09 00:48:40 monnier Exp $ | 8 ;; $Id: vc-sccs.el,v 1.5 2000/11/16 18:14:41 spiegel Exp $ |
| 9 | 9 |
| 10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
| 11 | 11 |
| 12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 13 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
| 119 (defun vc-sccs-workfile-version (file) | 119 (defun vc-sccs-workfile-version (file) |
| 120 "SCCS-specific version of `vc-workfile-version'." | 120 "SCCS-specific version of `vc-workfile-version'." |
| 121 (with-temp-buffer | 121 (with-temp-buffer |
| 122 (vc-insert-file (vc-name file) "^\001e") | 122 (vc-insert-file (vc-name file) "^\001e") |
| 123 (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))) | 123 (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))) |
| 124 | |
| 125 (defun vc-sccs-latest-on-branch-p (file) | |
| 126 "Return t iff the current workfile version of FILE is latest on its branch." | |
| 127 ;; Always return t; we do not support previous versions in the workfile | |
| 128 ;; under SCCS. | |
| 129 t) | |
| 130 | 124 |
| 131 (defun vc-sccs-checkout-model (file) | 125 (defun vc-sccs-checkout-model (file) |
| 132 "SCCS-specific version of `vc-checkout-model'." | 126 "SCCS-specific version of `vc-checkout-model'." |
| 133 'locking) | 127 'locking) |
| 134 | 128 |
| 194 (concat "-y" comment) | 188 (concat "-y" comment) |
| 195 switches) | 189 switches) |
| 196 (if vc-keep-workfiles | 190 (if vc-keep-workfiles |
| 197 (vc-do-command nil 0 "get" (vc-name file))))) | 191 (vc-do-command nil 0 "get" (vc-name file))))) |
| 198 | 192 |
| 199 (defun vc-sccs-checkout (file &optional writable rev workfile) | 193 (defun vc-sccs-checkout (file &optional editable rev workfile) |
| 200 "Retrieve a copy of a saved version of SCCS controlled FILE into a WORKFILE. | 194 "Retrieve a copy of a saved version of SCCS controlled FILE into a WORKFILE. |
| 201 WRITABLE non-nil means that the file should be writable. REV is the | 195 EDITABLE non-nil means that the file should be writable and |
| 202 revision to check out into WORKFILE." | 196 locked. REV is the revision to check out into WORKFILE." |
| 203 (let ((filename (or workfile file)) | 197 (let ((filename (or workfile file)) |
| 204 (file-buffer (get-file-buffer file)) | 198 (file-buffer (get-file-buffer file)) |
| 205 switches) | 199 switches) |
| 206 (message "Checking out %s..." filename) | 200 (message "Checking out %s..." filename) |
| 207 (save-excursion | 201 (save-excursion |
| 224 ;; Some SCCS implementations allow checking out directly to a | 218 ;; Some SCCS implementations allow checking out directly to a |
| 225 ;; file using the -G option, but then some don't so use the | 219 ;; file using the -G option, but then some don't so use the |
| 226 ;; least common denominator approach and use the -p option | 220 ;; least common denominator approach and use the -p option |
| 227 ;; ala RCS. | 221 ;; ala RCS. |
| 228 (let ((vc-modes (logior (file-modes (vc-name file)) | 222 (let ((vc-modes (logior (file-modes (vc-name file)) |
| 229 (if writable 128 0))) | 223 (if editable 128 0))) |
| 230 (failed t)) | 224 (failed t)) |
| 231 (unwind-protect | 225 (unwind-protect |
| 232 (progn | 226 (progn |
| 233 (let ((coding-system-for-read 'no-conversion) | 227 (let ((coding-system-for-read 'no-conversion) |
| 234 (coding-system-for-write 'no-conversion)) | 228 (coding-system-for-write 'no-conversion)) |
| 235 (with-temp-file filename | 229 (with-temp-file filename |
| 236 (apply 'vc-do-command | 230 (apply 'vc-do-command |
| 237 (current-buffer) 0 "get" (vc-name file) | 231 (current-buffer) 0 "get" (vc-name file) |
| 238 "-s" ;; suppress diagnostic output | 232 "-s" ;; suppress diagnostic output |
| 239 (if writable "-e") | 233 (if editable "-e") |
| 240 "-p" | 234 "-p" |
| 241 (and rev | 235 (and rev |
| 242 (concat "-r" | 236 (concat "-r" |
| 243 (vc-sccs-lookup-triple file rev))) | 237 (vc-sccs-lookup-triple file rev))) |
| 244 switches))) | 238 switches))) |
| 245 (set-file-modes filename | 239 (set-file-modes filename |
| 246 (logior (file-modes (vc-name file)) | 240 (logior (file-modes (vc-name file)) |
| 247 (if writable 128 0))) | 241 (if editable 128 0))) |
| 248 (setq failed nil)) | 242 (setq failed nil)) |
| 249 (and failed (file-exists-p filename) | 243 (and failed (file-exists-p filename) |
| 250 (delete-file filename)))) | 244 (delete-file filename)))) |
| 251 (apply 'vc-do-command nil 0 "get" (vc-name file) | 245 (apply 'vc-do-command nil 0 "get" (vc-name file) |
| 252 (if writable "-e") | 246 (if editable "-e") |
| 253 (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) | 247 (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) |
| 254 switches))))) | 248 switches))))) |
| 255 (message "Checking out %s...done" filename))) | 249 (message "Checking out %s...done" filename))) |
| 256 | 250 |
| 257 (defun vc-sccs-revert (file) | 251 (defun vc-sccs-revert (file) |
| 261 ;; Checking out explicit versions is not supported under SCCS, yet. | 255 ;; Checking out explicit versions is not supported under SCCS, yet. |
| 262 ;; We always "revert" to the latest version; therefore | 256 ;; We always "revert" to the latest version; therefore |
| 263 ;; vc-workfile-version is cleared here so that it gets recomputed. | 257 ;; vc-workfile-version is cleared here so that it gets recomputed. |
| 264 (vc-file-setprop file 'vc-workfile-version nil)) | 258 (vc-file-setprop file 'vc-workfile-version nil)) |
| 265 | 259 |
| 266 (defun vc-sccs-cancel-version (file writable) | 260 (defun vc-sccs-cancel-version (file editable) |
| 267 "Undo the most recent checkin of FILE. | 261 "Undo the most recent checkin of FILE. |
| 268 WRITABLE non-nil means previous version should be locked." | 262 EDITABLE non-nil means previous version should be locked." |
| 269 (vc-do-command nil 0 "rmdel" | 263 (vc-do-command nil 0 "rmdel" |
| 270 (vc-name file) | 264 (vc-name file) |
| 271 (concat "-r" (vc-workfile-version file))) | 265 (concat "-r" (vc-workfile-version file))) |
| 272 (vc-do-command nil 0 "get" | 266 (vc-do-command nil 0 "get" |
| 273 (vc-name file) | 267 (vc-name file) |
| 274 (if writable "-e"))) | 268 (if editable "-e"))) |
| 275 | 269 |
| 276 (defun vc-sccs-steal-lock (file &optional rev) | 270 (defun vc-sccs-steal-lock (file &optional rev) |
| 277 "Steal the lock on the current workfile for FILE and revision REV." | 271 "Steal the lock on the current workfile for FILE and revision REV." |
| 278 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev))) | 272 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev))) |
| 279 (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev)))) | 273 (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev)))) |