Isolating support code for the file-granularity back ends: the easy part.
* vc-filewise.el: New file to isolate code used only by the file-oriented back ends (SCCS/RCS/CVS/SRC) which should not live in vc.el and certainly not in vc-hooks.el.
This commit is contained in:
Eric S. Raymond
parent
af46a2a43f
commit
354a07b570
4 changed files with 134 additions and 52 deletions
|
|
@ -1,5 +1,9 @@
|
|||
2014-11-22 Eric S. Raymond <esr@snark>
|
||||
|
||||
* vc-filewise.el: New file to isolate code used only by the
|
||||
file-oriented back ends (SCCS/RCS/CVS/SRC) which should not
|
||||
live in vc.el and certainly not in vc-hooks.el.
|
||||
|
||||
* vc-hooks.el, vc-rcs.el, vc-sccs.el: vc-name -> vc-master-name.
|
||||
This is preaparatory to isolating all the 'master' functions
|
||||
used only by the file-oriented back ends. With this done first,
|
||||
|
|
|
|||
130
lisp/vc/vc-filewise.el
Normal file
130
lisp/vc/vc-filewise.el
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
;;; vc-filewise.el --- common functions for file-oriented back ends.
|
||||
|
||||
;; Copyright (C) 1992-1996, 1998-2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: FSF (see vc.el for full credits)
|
||||
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
|
||||
;; Package: vc
|
||||
|
||||
;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Common functions for file-oriented back ends - SCCS, RCS, SRC, CVS
|
||||
;;
|
||||
;; The main purpose of this file is so none od this code jas to like
|
||||
;; in the always-resident vc-hooks. A secondary purpose is to remove
|
||||
;; code specific to this class of back ends from vc.el.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'vc))
|
||||
|
||||
(defun vc-master-name (file)
|
||||
"Return the master name of FILE.
|
||||
If the file is not registered, or the master name is not known, return nil."
|
||||
(or (vc-file-getprop file 'vc-name)
|
||||
;; force computation of the property by calling
|
||||
;; vc-BACKEND-registered explicitly
|
||||
(let ((backend (vc-backend file)))
|
||||
(if (and backend
|
||||
(vc-call-backend backend 'registered file))
|
||||
(vc-file-getprop file 'vc-name)))))
|
||||
|
||||
(defun vc-rename-master (oldmaster newfile templates)
|
||||
"Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
|
||||
(let* ((dir (file-name-directory (expand-file-name oldmaster)))
|
||||
(newdir (or (file-name-directory newfile) ""))
|
||||
(newbase (file-name-nondirectory newfile))
|
||||
(masters
|
||||
;; List of potential master files for `newfile'
|
||||
(mapcar
|
||||
(lambda (s) (vc-possible-master s newdir newbase))
|
||||
templates)))
|
||||
(when (or (file-symlink-p oldmaster)
|
||||
(file-symlink-p (file-name-directory oldmaster)))
|
||||
(error "This is unsafe in the presence of symbolic links"))
|
||||
(rename-file
|
||||
oldmaster
|
||||
(catch 'found
|
||||
;; If possible, keep the master file in the same directory.
|
||||
(dolist (f masters)
|
||||
(when (and f (string= (file-name-directory (expand-file-name f)) dir))
|
||||
(throw 'found f)))
|
||||
;; If not, just use the first possible place.
|
||||
(dolist (f masters)
|
||||
(and f (or (not (setq dir (file-name-directory f)))
|
||||
(file-directory-p dir))
|
||||
(throw 'found f)))
|
||||
(error "New file lacks a version control directory")))))
|
||||
|
||||
(defun vc-filewise-registered (backend file)
|
||||
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
|
||||
(let ((sym (vc-make-backend-sym backend 'master-templates)))
|
||||
(unless (get backend 'vc-templates-grabbed)
|
||||
(put backend 'vc-templates-grabbed t))
|
||||
(let ((result (vc-check-master-templates file (symbol-value sym))))
|
||||
(if (stringp result)
|
||||
(vc-file-setprop file 'vc-name result)
|
||||
nil)))) ; Not registered
|
||||
|
||||
(defun vc-possible-master (s dirname basename)
|
||||
(cond
|
||||
((stringp s) (format s dirname basename))
|
||||
((functionp s)
|
||||
;; The template is a function to invoke. If the
|
||||
;; function returns non-nil, that means it has found a
|
||||
;; master. For backward compatibility, we also handle
|
||||
;; the case that the function throws a 'found atom
|
||||
;; and a pair (cons MASTER-FILE BACKEND).
|
||||
(let ((result (catch 'found (funcall s dirname basename))))
|
||||
(if (consp result) (car result) result)))))
|
||||
|
||||
(defun vc-check-master-templates (file templates)
|
||||
"Return non-nil if there is a master corresponding to FILE.
|
||||
|
||||
TEMPLATES is a list of strings or functions. If an element is a
|
||||
string, it must be a control string as required by `format', with two
|
||||
string placeholders, such as \"%sRCS/%s,v\". The directory part of
|
||||
FILE is substituted for the first placeholder, the basename of FILE
|
||||
for the second. If a file with the resulting name exists, it is taken
|
||||
as the master of FILE, and returned.
|
||||
|
||||
If an element of TEMPLATES is a function, it is called with the
|
||||
directory part and the basename of FILE as arguments. It should
|
||||
return non-nil if it finds a master; that value is then returned by
|
||||
this function."
|
||||
(let ((dirname (or (file-name-directory file) ""))
|
||||
(basename (file-name-nondirectory file)))
|
||||
(catch 'found
|
||||
(mapcar
|
||||
(lambda (s)
|
||||
(let ((trial (vc-possible-master s dirname basename)))
|
||||
(when (and trial (file-exists-p trial)
|
||||
;; Make sure the file we found with name
|
||||
;; TRIAL is not the source file itself.
|
||||
;; That can happen with RCS-style names if
|
||||
;; the file name is truncated (e.g. to 14
|
||||
;; chars). See if either directory or
|
||||
;; attributes differ.
|
||||
(or (not (string= dirname
|
||||
(file-name-directory trial)))
|
||||
(not (equal (file-attributes file)
|
||||
(file-attributes trial)))))
|
||||
(throw 'found trial))))
|
||||
templates))))
|
||||
|
||||
(provide 'vc-filewise)
|
||||
|
|
@ -454,19 +454,6 @@ If the argument is a list, the files must all have the same back end."
|
|||
"Return where the repository for the current directory is kept."
|
||||
(symbol-name (vc-backend file)))
|
||||
|
||||
(defun vc-master-name (file)
|
||||
"Return the master name of FILE.
|
||||
If the file is not registered, or the master name is not known, return nil."
|
||||
;; TODO: This should ultimately become obsolete, at least up here
|
||||
;; in vc-hooks.
|
||||
(or (vc-file-getprop file 'vc-master-name)
|
||||
;; force computation of the property by calling
|
||||
;; vc-BACKEND-registered explicitly
|
||||
(let ((backend (vc-backend file)))
|
||||
(if (and backend
|
||||
(vc-call-backend backend 'registered file))
|
||||
(vc-file-getprop file 'vc-master-name)))))
|
||||
|
||||
(defun vc-checkout-model (backend files)
|
||||
"Indicate how FILES are checked out.
|
||||
|
||||
|
|
@ -650,18 +637,6 @@ If FILE is not registered, this function always returns nil."
|
|||
(vc-file-setprop file 'vc-master-name result)
|
||||
nil)))) ; Not registered
|
||||
|
||||
(defun vc-possible-master (s dirname basename)
|
||||
(cond
|
||||
((stringp s) (format s dirname basename))
|
||||
((functionp s)
|
||||
;; The template is a function to invoke. If the
|
||||
;; function returns non-nil, that means it has found a
|
||||
;; master. For backward compatibility, we also handle
|
||||
;; the case that the function throws a 'found atom
|
||||
;; and a pair (cons MASTER-FILE BACKEND).
|
||||
(let ((result (catch 'found (funcall s dirname basename))))
|
||||
(if (consp result) (car result) result)))))
|
||||
|
||||
(defun vc-check-master-templates (file templates)
|
||||
"Return non-nil if there is a master corresponding to FILE.
|
||||
|
||||
|
|
|
|||
|
|
@ -2691,33 +2691,6 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
|
|||
(vc-mode-line file new-backend)
|
||||
(vc-checkin file new-backend comment (stringp comment)))))
|
||||
|
||||
(defun vc-rename-master (oldmaster newfile templates)
|
||||
"Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
|
||||
(let* ((dir (file-name-directory (expand-file-name oldmaster)))
|
||||
(newdir (or (file-name-directory newfile) ""))
|
||||
(newbase (file-name-nondirectory newfile))
|
||||
(masters
|
||||
;; List of potential master files for `newfile'
|
||||
(mapcar
|
||||
(lambda (s) (vc-possible-master s newdir newbase))
|
||||
templates)))
|
||||
(when (or (file-symlink-p oldmaster)
|
||||
(file-symlink-p (file-name-directory oldmaster)))
|
||||
(error "This is unsafe in the presence of symbolic links"))
|
||||
(rename-file
|
||||
oldmaster
|
||||
(catch 'found
|
||||
;; If possible, keep the master file in the same directory.
|
||||
(dolist (f masters)
|
||||
(when (and f (string= (file-name-directory (expand-file-name f)) dir))
|
||||
(throw 'found f)))
|
||||
;; If not, just use the first possible place.
|
||||
(dolist (f masters)
|
||||
(and f (or (not (setq dir (file-name-directory f)))
|
||||
(file-directory-p dir))
|
||||
(throw 'found f)))
|
||||
(error "New file lacks a version control directory")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun vc-delete-file (file)
|
||||
"Delete file and mark it as such in the version control system.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue