mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

(vc-sccs-latest-on-branch-p): Always return t; we

Browse Source 
don't support anything else under SCCS yet.
(vc-sccs-update-changelog): Dummy implementation that
simply signals an error.
(vc-sccs-state-heuristic): Use
file-ownership-preserved-p.
(vc-sccs-workfile-unchanged-p): Fix call to
vc-do-command.
(vc-sccs-state-heuristic): Don't use file-writable-p.
(vc-sccs-workfile-unchanged-p): Fix parenthesis.
(vc-sccs-print-log, vc-sccs-diff): Insert in the current buffer.
(vc-sccs-workfile-unchanged-p): Rewritten.
(vc-sccs-diff): Remove optional arg CMP.
(vc-sccs-state): Call vc-workfile-unchanged-p, not the
SCCS-specific function.
(vc-sccs-state): Fix obviously wrong parenthesis.
(vc-sccs-state-heuristic): Use file-writable-p instead of
comparing userids.
(vc-sccs-checkout): Use `unless'.
(vc-sccs-state): Use with-temp-buffer.
(vc-sccs-workfile-version): Use with-temp-buffer and new
vc-parse-buffer and don't bother setting the property.
(vc-sccs-add-triple): Use with-current-buffer and
find-file-noselect.
(vc-sccs-lookup-triple): New vc-parse-buffer and turn cond -> if.
 Merge in
code from vc-sccs-hooks.el.
(vc-sccs-release, vc-sccs-system-release): Remove.  Don't require
'vc anymore.
(vc-sccs-responsible-p): Use expand-file-name instead of concat
and file-directory-p instead of file-exists-p.
(vc-sccs-check-headers): Simplify the regexp.
(vc-sccs-responsible-p, vc-sccs-register): Use
`vc-sccs-search-project-dir' instead of `vc-sccs-project-dir'.
(vc-sccs-header): New var.
(vc-sccs-rename-file): Renamed from
vc-sccs-record-rename.  Use `find-file-noselect' rather than
`find-file' and call `vc-rename-master' to do the actual move.
(vc-sccs-diff): Remove unused `backend' variable.
(tail): Provide vc-sccs.
(vc-sccs-checkout): Removed call to
vc-file-clear-masterprops.  If writable, set vc-state to 'edited
rather than user login name.
 Require 'vc and 'vc-sccs-hooks.
(vc-sccs-register-switches): New var, copied off of vc-rcs-hooks.
(vc-sccs-latest-on-branch-p): Add a `FIXME' for a call to the
unknown `vc-latest-version' function.  It should probably refer to
vc-workfile-version or somesuch, but it's very unclear to me and I
don't have SCCS to test things.
(vc-sccs-steal-lock): Renamed from `vc-sccs-steal'.
(vc-BACKEND-responsible-p): New
functions.
(vc-BACKEND-register): Renamed from `vc-BACKEND-admin'.  Removed
query option.  Redocumented.
(vc-sccs-diff): Function changed name from
`vc-backend-diff'.  This makes `vc-diff' work.
(vc-sccs-release): Doc fix.
(vc-sccs-admin): Added the query-only option as
required by the vc.el file.
(vc-sccs-latest-on-branch-p): Function added.
(vc-sccs-diff): Function added.
(vc-sccs-checkout): Added function `vc-sccs-checkout'.
 Require vc when compiling.
(vc-sccs-print-log, vc-sccs-assign-name, vc-sccs-merge)
(vc-sccs-check-headers, vc-sccs-steal, vc-sccs-uncheck)
(vc-sccs-revert)
(vc-sccs-checkin, vc-sccs-logentry-check): New functions (code
from vc.el).
(vc-sccs-add-triple, vc-sccs-record-rename)
(vc-sccs-lookup-triple): Moved from vc.el and renamed.
(vc-sccs-admin): Doc fix.
(vc-admin-sccs): Added from vc.el
(vc-sccs-system-release):
Renamed from vc-sccs-backend-release.
(vc-sccs-release): Moved from vc.el.
(vc-sccs-backend-release): New function.
This commit is contained in:
Gerd Moellmann 2000-09-04 19:49:01 +00:00
parent c1b2509982
commit 7a004b71e1
2 changed files with 1914 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1526
lisp/ChangeLog
View File

File diff suppressed because it is too large Load Diff

388
lisp/vc-sccs.el Normal file
View File

@ -0,0 +1,388 @@
;;; vc-sccs.el --- support for SCCS version-control
;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; $Id: vc-sccs.el,v 1.35 2000/08/13 11:52:19 spiegel Exp $
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(defcustom vc-sccs-register-switches nil
"*A string or list of strings; extra switches for registering a file
in |SCCS. These are passed to the checkin program by
\\[vc-sccs-register]."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List"
:value ("")
string))
:group 'vc)
(defcustom vc-sccs-header (or (cdr (assoc 'SCCS vc-header-alist)) '("%W%"))
"*Header keywords to be inserted by `vc-insert-headers'."
:type 'string
:group 'vc)
;;;###autoload
(defcustom vc-sccs-master-templates
'("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)
"*Where to look for SCCS master files.
For a description of possible values, see `vc-check-master-templates'."
:type '(choice (const :tag "Use standard SCCS file names"
("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir))
(repeat :tag "User-specified"
(choice string
function)))
:version "20.5"
:group 'vc)
;;;###autoload
(progn (defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)))
(defun vc-sccs-state (file)
"SCCS-specific function to compute the version control state."
(with-temp-buffer
(if (vc-insert-file (vc-sccs-lock-file file))
(let* ((locks (vc-sccs-parse-locks))
(workfile-version (vc-workfile-version file))
(locking-user (cdr (assoc workfile-version locks))))
(if (not locking-user)
(if (vc-workfile-unchanged-p file)
'up-to-date
'unlocked-changes)
(if (string= locking-user (vc-user-login-name))
'edited
locking-user)))
'up-to-date)))
(defun vc-sccs-state-heuristic (file)
"SCCS-specific state heuristic."
(if (not (vc-mistrust-permissions file))
;; This implementation assumes that any file which is under version
;; control and has -rw-r--r-- is locked by its owner. This is true
;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
;; We have to be careful not to exclude files with execute bits on;
;; scripts can be under version control too. Also, we must ignore the
;; group-read and other-read bits, since paranoid users turn them off.
(let* ((attributes (file-attributes file))
(owner-uid (nth 2 attributes))
(permissions (nth 8 attributes)))
(if (string-match ".r-..-..-." permissions)
'up-to-date
(if (string-match ".rw..-..-." permissions)
(if (file-ownership-preserved-p file)
'edited
(vc-user-login-name owner-uid))
;; Strange permissions.
;; Fall through to real state computation.
(vc-sccs-state file)))
(vc-sccs-state file))))
(defun vc-sccs-workfile-version (file)
"SCCS-specific version of `vc-workfile-version'."
(with-temp-buffer
(vc-insert-file (vc-name file) "^\001e")
(vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
(defun vc-sccs-checkout-model (file)
"SCCS-specific version of `vc-checkout-model'."
'locking)
(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)))))
;; internal code
;; This function is wrapped with `progn' so that the autoload cookie
;; copies the whole function itself into loaddefs.el rather than just placing
;; a (autoload 'vc-sccs-search-project-dir "vc-sccs") which would not
;; help us avoid loading vc-sccs.
;;;###autoload
(progn (defun vc-sccs-search-project-dir (dirname basename)
"Return the name of a master file in the SCCS project directory.
Does not check whether the file exists but returns nil if it does not
find any project directory."
(let ((project-dir (getenv "PROJECTDIR")) dirs dir)
(when project-dir
(if (file-name-absolute-p project-dir)
(setq dirs '("SCCS" ""))
(setq dirs '("src/SCCS" "src" "source/SCCS" "source"))
(setq project-dir (expand-file-name (concat "~" project-dir))))
(while (and (not dir) dirs)
(setq dir (expand-file-name (car dirs) project-dir))
(unless (file-directory-p dir)
(setq dir nil)
(setq dirs (cdr dirs))))
(and dir (expand-file-name (concat "s." basename) dir))))))
(defun vc-sccs-lock-file (file)
"Generate lock file name corresponding to FILE."
(let ((master (vc-name file)))
(and
master
(string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master)
(replace-match "p." t t master 2))))
(defun vc-sccs-parse-locks ()
"Parse SCCS locks in current buffer.
The result is a list of the form ((VERSION . USER) (VERSION . USER) ...)."
(let (master-locks)
(goto-char (point-min))
(while (re-search-forward "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
nil t)
(setq master-locks
(cons (cons (match-string 1) (match-string 2)) master-locks)))
;; FIXME: is it really necessary to reverse ?
(nreverse master-locks)))
(defun vc-sccs-print-log (file)
"Get change log associated with FILE."
(vc-do-command t 0 "prs" (vc-name file)))
(defun vc-sccs-assign-name (file name)
"Assign to FILE's latest version a given NAME."
(vc-sccs-add-triple name file (vc-workfile-version file)))
;; Named-configuration support
(defun vc-sccs-add-triple (name file rev)
(with-current-buffer
(find-file-noselect
(expand-file-name vc-name-assoc-file
(file-name-directory (vc-name file))))
(goto-char (point-max))
(insert name "\t:\t" file "\t" rev "\n")
(basic-save-buffer)
(kill-buffer (current-buffer))))
(defun vc-sccs-rename-file (old new)
;; Move the master file (using vc-rcs-master-templates).
(vc-rename-master (vc-name old) new vc-sccs-master-templates)
;; Update the snapshot file.
(with-current-buffer
(find-file-noselect
(expand-file-name vc-name-assoc-file
(file-name-directory (vc-name old))))
(goto-char (point-min))
;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
(while (re-search-forward (concat ":" (regexp-quote old) "$") nil t)
(replace-match (concat ":" new) nil nil))
(basic-save-buffer)
(kill-buffer (current-buffer))))
(defun vc-sccs-lookup-triple (file name)
"Return the numeric version corresponding to a named snapshot of FILE.
If NAME is nil or a version number string it's just passed through."
(if (or (null name)
(let ((firstchar (aref name 0)))
(and (>= firstchar ?0) (<= firstchar ?9))))
name
(with-temp-buffer
(vc-insert-file
(expand-file-name vc-name-assoc-file
(file-name-directory (vc-name file))))
(vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
(defun vc-sccs-merge (file first-version &optional second-version)
(error "Merging not implemented for SCCS"))
(defun vc-sccs-check-headers ()
"Check if the current file has any headers in it."
(save-excursion
(goto-char (point-min))
(re-search-forward "%[A-Z]%" nil t)))
(defun vc-sccs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV."
(vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
(vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev))))
(defun vc-sccs-uncheck (file target)
"Undo the checkin of FILE's revision TARGET."
(vc-do-command nil 0 "rmdel" (vc-name file) (concat "-r" target)))
(defun vc-sccs-revert (file)
"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))
;; Checking out explicit versions is not supported under SCCS, yet.
;; We always "revert" to the latest version; therefore
;; vc-workfile-version is cleared here so that it gets recomputed.
(vc-file-setprop file 'vc-workfile-version nil))
(defun vc-sccs-checkin (file rev comment)
"SCCS-specific version of `vc-backend-checkin'."
(let ((switches (if (stringp vc-checkin-switches)
(list vc-checkin-switches)
vc-checkin-switches)))
(apply 'vc-do-command nil 0 "delta" (vc-name file)
(if rev (concat "-r" rev))
(concat "-y" comment)
switches)
(vc-file-setprop file 'vc-state 'up-to-date)
(vc-file-setprop file 'vc-workfile-version nil)
(if vc-keep-workfiles
(vc-do-command nil 0 "get" (vc-name file)))))
(defun vc-sccs-latest-on-branch-p (file)
"Return t iff the current workfile version of FILE is the latest on
its branch."
;; Always return t; we do not support previous versions in the workfile
;; under SCCS.
t)
(defun vc-sccs-logentry-check ()
"Check that the log entry in the current buffer is acceptable for SCCS."
(when (>= (buffer-size) 512)
(goto-char 512)
(error "Log must be less than 512 characters; point is now at pos 512")))
(defun vc-sccs-diff (file &optional oldvers newvers)
"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)))
(defun vc-sccs-responsible-p (file)
"Return non-nil if SCCS thinks it would be responsible for registering FILE."
;; TODO: check for all the patterns in vc-sccs-master-templates
(or (file-directory-p (expand-file-name "SCCS" (file-name-directory file)))
(stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
(file-name-nondirectory file)))))
(defun vc-sccs-register (file &optional rev comment)
"Register FILE into the SCCS version-control system.
REV is the optional revision number for the file. COMMENT can be used
to provide an initial description of FILE.
`vc-register-switches' and `vc-sccs-register-switches' are passed to
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."
(vc-file-clearprops file)
(let* ((switches (list
(if (stringp vc-register-switches)
(list vc-register-switches)
vc-register-switches)
(if (stringp vc-sccs-register-switches)
(list vc-sccs-register-switches)
vc-sccs-register-switches)))
(dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file))
(project-file (vc-sccs-search-project-dir dirname basename)))
(let ((vc-name
(or project-file
(format (car vc-sccs-master-templates) dirname basename)))|)
(apply 'vc-do-command nil 0 "admin" nil
(and rev (concat "-r" rev))
"-fb"
(concat "-i" file)
(and comment (concat "-y" comment))
vc-name
switches))
(delete-file file)
(if vc-keep-workfiles
(vc-do-command nil 0 "get" (vc-name file)))))
(defun vc-sccs-checkout (file &optional writable rev workfile)
"Retrieve a copy of a saved version of an SCCS controlled FILE into
a WORKFILE. WRITABLE non-nil means that the file should be writable.
REV is the revision to check out into WORKFILE."
(let ((filename (or workfile file))
(file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." filename)
(save-excursion
;; Change buffers to get local value of vc-checkout-switches.
(if file-buffer (set-buffer file-buffer))
(setq switches (if (stringp vc-checkout-switches)
(list vc-checkout-switches)
vc-checkout-switches))
;; Save this buffer's default-directory
;; and use save-excursion to make sure it is restored
;; in the same buffer it was saved in.
(let ((default-directory default-directory))
(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))
(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 writable 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 writable "-e")
"-p"
(and rev
(concat "-r"
(vc-sccs-lookup-triple file rev)))
switches)))
(set-file-modes filename
(logior (file-modes (vc-name file))
(if writable 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 writable "-e")
(and rev (concat "-r" (vc-sccs-lookup-triple file rev)))
switches)
(vc-file-setprop file 'vc-workfile-version nil))
(unless workfile
(if writable
(vc-file-setprop file 'vc-state 'edited))
(vc-file-setprop file
'vc-checkout-time (nth 5 (file-attributes file))))
(message "Checking out %s...done" filename))))))
(defun vc-sccs-update-changelog (files)
(error "Sorry, generating ChangeLog entries is not implemented for SCCS."))
(provide 'vc-sccs)
;;; vc-sccs.el ends here