X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8b7c899181413b8f0f769c5f85f8bd7b11111582..1169bd863a0a7a8c9a49039e4dd1a9860845cf1d:/lisp/vc-sccs.el diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el index c37c37e647..9de8c3ccad 100644 --- a/lisp/vc-sccs.el +++ b/lisp/vc-sccs.el @@ -1,11 +1,11 @@ ;;; vc-sccs.el --- support for SCCS version-control -;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc. +;; Copyright (C) 1992,93,94,95,96,97,98,99,2000,2001 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id: vc-sccs.el,v 1.6 2001/01/08 16:26:44 spiegel Exp $ +;; $Id: vc-sccs.el,v 1.18 2002/11/12 19:50:54 rost Exp $ ;; This file is part of GNU Emacs. @@ -28,6 +28,9 @@ ;;; Code: +(eval-when-compile + (require 'vc)) + ;;; ;;; Customization options ;;; @@ -44,6 +47,17 @@ A string or list of strings passed to the checkin program by :version "21.1" :group 'vc) +(defcustom vc-sccs-diff-switches nil + "*A string or list of strings specifying extra switches for `vcdiff', +the diff utility used for SCCS under VC." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" + :value ("") + string)) + :version "21.1" + :group 'vc) + (defcustom vc-sccs-header (or (cdr (assoc 'SCCS vc-header-alist)) '("%W%")) "*Header keywords to be inserted by `vc-insert-headers'." :type '(repeat string) @@ -74,8 +88,13 @@ For a description of possible values, see `vc-check-master-templates'." ;;; State-querying functions ;;; -;;;###autoload -(progn (defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))) +;;; The autoload cookie below places vc-sccs-registered directly into +;;; loaddefs.el, so that vc-sccs.el does not need to be loaded for +;;; every file that is visited. The definition is repeated below +;;; so that Help and etags can find it. + +;;;###autoload (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f)) +(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)) (defun vc-sccs-state (file) "SCCS-specific function to compute the version control state." @@ -128,9 +147,9 @@ For a description of possible values, see `vc-check-master-templates'." (defun vc-sccs-workfile-unchanged-p (file) "SCCS-specific implementation of vc-workfile-unchanged-p." - (apply 'vc-do-command nil 1 "vcdiff" (vc-name file) - (list "--brief" "-q" - (concat "-r" (vc-workfile-version file))))) + (zerop (apply 'vc-do-command nil 1 "vcdiff" (vc-name file) + (list "--brief" "-q" + (concat "-r" (vc-workfile-version file)))))) ;;; @@ -147,7 +166,7 @@ the SCCS command (in that order). Automatically retrieve a read-only version of the file with keywords expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." - (let* ((switches (list + (let* ((switches (append (if (stringp vc-register-switches) (list vc-register-switches) vc-register-switches) @@ -160,12 +179,11 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (let ((vc-name (or project-file (format (car vc-sccs-master-templates) dirname basename)))|) - (apply 'vc-do-command nil 0 "admin" nil + (apply 'vc-do-command nil 0 "admin" vc-name (and rev (concat "-r" rev)) "-fb" - (concat "-i" file) + (concat "-i" (file-relative-name file)) (and comment (concat "-y" comment)) - vc-name switches)) (delete-file file) (if vc-keep-workfiles @@ -190,14 +208,25 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (if vc-keep-workfiles (vc-do-command nil 0 "get" (vc-name file))))) -(defun vc-sccs-checkout (file &optional editable rev workfile) - "Retrieve a copy of a saved version of SCCS controlled FILE into a WORKFILE. +(defun vc-sccs-find-version (file rev buffer) + (apply 'vc-do-command + buffer 0 "get" (vc-name file) + "-s" ;; suppress diagnostic output + "-p" + (and rev + (concat "-r" + (vc-sccs-lookup-triple file rev))) + (if (stringp vc-checkout-switches) + (list vc-checkout-switches) + vc-checkout-switches))) + +(defun vc-sccs-checkout (file &optional editable rev) + "Retrieve a copy of a saved version of SCCS controlled FILE. EDITABLE non-nil means that the file should be writable and -locked. REV is the revision to check out into WORKFILE." - (let ((filename (or workfile file)) - (file-buffer (get-file-buffer file)) +locked. REV is the revision to check out." + (let ((file-buffer (get-file-buffer file)) switches) - (message "Checking out %s..." filename) + (message "Checking out %s..." file) (save-excursion ;; Change buffers to get local value of vc-checkout-switches. (if file-buffer (set-buffer file-buffer)) @@ -211,44 +240,16 @@ locked. REV is the revision to check out into WORKFILE." (save-excursion ;; Adjust the default-directory so that the check-out creates ;; the file in the right place. - (setq default-directory (file-name-directory filename)) + (setq default-directory (file-name-directory file)) (and rev (string= rev "") (setq rev nil)) - (if workfile - ;; Some SCCS implementations allow checking out directly to a - ;; file using the -G option, but then some don't so use the - ;; least common denominator approach and use the -p option - ;; ala RCS. - (let ((vc-modes (logior (file-modes (vc-name file)) - (if editable 128 0))) - (failed t)) - (unwind-protect - (progn - (let ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) - (with-temp-file filename - (apply 'vc-do-command - (current-buffer) 0 "get" (vc-name file) - "-s" ;; suppress diagnostic output - (if editable "-e") - "-p" - (and rev - (concat "-r" - (vc-sccs-lookup-triple file rev))) - switches))) - (set-file-modes filename - (logior (file-modes (vc-name file)) - (if editable 128 0))) - (setq failed nil)) - (and failed (file-exists-p filename) - (delete-file filename)))) - (apply 'vc-do-command nil 0 "get" (vc-name file) - (if editable "-e") - (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) - switches))))) - (message "Checking out %s...done" filename))) - -(defun vc-sccs-revert (file) + (apply 'vc-do-command nil 0 "get" (vc-name file) + (if editable "-e") + (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) + switches)))) + (message "Checking out %s...done" file))) + +(defun vc-sccs-revert (file &optional contents-done) "Revert FILE to the version it was based on." (vc-do-command nil 0 "unget" (vc-name file)) (vc-do-command nil 0 "get" (vc-name file)) @@ -279,7 +280,7 @@ EDITABLE non-nil means previous version should be locked." (defun vc-sccs-print-log (file) "Get change log associated with FILE." - (vc-do-command t 0 "prs" (vc-name file))) + (vc-do-command nil 0 "prs" (vc-name file))) (defun vc-sccs-logentry-check () "Check that the log entry in the current buffer is acceptable for SCCS." @@ -291,14 +292,11 @@ EDITABLE non-nil means previous version should be locked." "Get a difference report using SCCS between two versions of FILE." (setq oldvers (vc-sccs-lookup-triple file oldvers)) (setq newvers (vc-sccs-lookup-triple file newvers)) - (let* ((diff-switches-list (if (listp diff-switches) - diff-switches - (list diff-switches))) - (options (append (list "-q" - (and oldvers (concat "-r" oldvers)) - (and newvers (concat "-r" newvers))) - diff-switches-list))) - (apply 'vc-do-command t 1 "vcdiff" (vc-name file) options))) + (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" (vc-name file) + (append (list "-q" + (and oldvers (concat "-r" oldvers)) + (and newvers (concat "-r" newvers))) + (vc-diff-switches-list 'SCCS)))) ;;; @@ -408,6 +406,3 @@ If NAME is nil or a version number string it's just passed through." (provide 'vc-sccs) ;;; vc-sccs.el ends here - - -