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

Generalize stay-local-p to operatre on lists of files.

Browse Source 
Change two keybindings to point to new function names.
This commit is contained in:
Eric S. Raymond 2007-07-18 12:43:37 +00:00
parent 3eaf40f78c
commit e4d2689288
2 changed files with 64 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
lisp/vc-hooks.el
View File

@ -160,31 +160,33 @@ by these regular expressions."
(defun vc-stay-local-p (file)
"Return non-nil if VC should stay local when handling FILE.
This uses the `repository-hostname' backend operation."
(let* ((backend (vc-backend file))
(sym (vc-make-backend-sym backend 'stay-local))
(stay-local (if (boundp sym) (symbol-value sym) t)))
(if (eq stay-local t) (setq stay-local vc-stay-local))
(if (symbolp stay-local) stay-local
(let ((dirname (if (file-directory-p file)
(directory-file-name file)
(file-name-directory file))))
(eq 'yes
(or (vc-file-getprop dirname 'vc-stay-local-p)
(vc-file-setprop
dirname 'vc-stay-local-p
(let ((hostname (vc-call-backend
backend 'repository-hostname dirname)))
(if (not hostname)
'no
(let ((default t))
(if (eq (car-safe stay-local) 'except)
(setq default nil stay-local (cdr stay-local)))
(when (consp stay-local)
(setq stay-local
(mapconcat 'identity stay-local "\\|")))
(if (if (string-match stay-local hostname)
default (not default))
'yes 'no)))))))))))
(if (listp file)
(if (remove-if-not (lambda (x) (not (vc-stay-local-p x))) file) 'no 'yes)
(let* ((backend (vc-backend file))
(sym (vc-make-backend-sym backend 'stay-local))
(stay-local (if (boundp sym) (symbol-value sym) t)))
(if (eq stay-local t) (setq stay-local vc-stay-local))
(if (symbolp stay-local) stay-local
(let ((dirname (if (file-directory-p file)
(directory-file-name file)
(file-name-directory file))))
(eq 'yes
(or (vc-file-getprop dirname 'vc-stay-local-p)
(vc-file-setprop
dirname 'vc-stay-local-p
(let ((hostname (vc-call-backend
backend 'repository-hostname dirname)))
(if (not hostname)
'no
(let ((default t))
(if (eq (car-safe stay-local) 'except)
(setq default nil stay-local (cdr stay-local)))
(when (consp stay-local)
(setq stay-local
(mapconcat 'identity stay-local "\\|")))
(if (if (string-match stay-local hostname)
default (not default))
'yes 'no))))))))))))
;;; This is handled specially now.
;; Tell Emacs about this new kind of minor mode
@ -373,20 +375,26 @@ backend is tried first."
(vc-file-setprop file 'vc-backend 'none)
nil)))))
(defun vc-backend (file)
"Return the version control type of FILE, nil if it is not registered."
(defun vc-backend (file-or-list)
"Return the version control type of FILE-OR-LIST, nil if it's not registered.
If the argument is a list, the files must all have the same back end."
;; `file' can be nil in several places (typically due to the use of
;; code like (vc-backend buffer-file-name)).
(when (stringp file)
(let ((property (vc-file-getprop file 'vc-backend)))
;; Note that internally, Emacs remembers unregistered
;; files by setting the property to `none'.
(cond ((eq property 'none) nil)
(property)
;; vc-registered sets the vc-backend property
(t (if (vc-registered file)
(vc-file-getprop file 'vc-backend)
nil))))))
(cond ((stringp file-or-list)
(let ((property (vc-file-getprop file-or-list 'vc-backend)))
;; Note that internally, Emacs remembers unregistered
;; files by setting the property to `none'.
(cond ((eq property 'none) nil)
(property)
;; vc-registered sets the vc-backend property
(t (if (vc-registered file-or-list)
(vc-file-getprop file-or-list 'vc-backend)
nil)))))
((and file-or-list (listp file-or-list))
(vc-backend (car file-or-list)))
(t
nil)))
(defun vc-backend-subdirectory-name (file)
"Return where the master and lock FILEs for the current directory are kept."
@ -480,7 +488,7 @@ For registered files, the value returned is one of:
;; - `removed'
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
(if (vc-backend file)
(if (and (> (length file) 0) (vc-backend file))
(vc-file-setprop file 'vc-state
(vc-call state-heuristic file)))))
@ -532,7 +540,7 @@ Return non-nil if FILE is unchanged."
(vc-call diff file))))))
(defun vc-workfile-version (file)
"Return the version level of the current workfile FILE.
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-workfile-version)
(if (vc-backend file)
@ -873,7 +881,7 @@ Used in `find-file-not-found-functions'."
(let ((map (make-sparse-keymap)))
(define-key map "a" 'vc-update-change-log)
(define-key map "b" 'vc-switch-backend)
(define-key map "c" 'vc-cancel-version)
(define-key map "c" 'vc-rollback)
(define-key map "d" 'vc-directory)
(define-key map "g" 'vc-annotate)
(define-key map "h" 'vc-insert-headers)
@ -882,8 +890,9 @@ Used in `find-file-not-found-functions'."
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-snapshot)
(define-key map "s" 'vc-create-snapshot)
(define-key map "u" 'vc-revert-buffer)
(define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
(define-key map "=" 'vc-diff)
(define-key map "~" 'vc-version-other-window)
map))
@ -913,9 +922,9 @@ Used in `find-file-not-found-functions'."
(define-key vc-menu-map [separator2] '("----"))
(define-key vc-menu-map [vc-insert-header]
'("Insert Header" . vc-insert-headers))
(define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
(define-key vc-menu-map [vc-revert-buffer]
'("Revert to Base Version" . vc-revert-buffer))
(define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-rollback))
(define-key vc-menu-map [vc-revert]
'("Revert to Base Version" . vc-revert))
(define-key vc-menu-map [vc-update]
'("Update to Latest Version" . vc-update))
(define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
@ -932,8 +941,8 @@ Used in `find-file-not-found-functions'."
;;(put 'vc-update-change-log 'menu-enable
;; '(member (vc-buffer-backend) '(RCS CVS)))
;;(put 'vc-print-log 'menu-enable 'vc-mode)
;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)
;;(put 'vc-rollback 'menu-enable 'vc-mode)
;;(put 'vc-revert 'menu-enable 'vc-mode)
;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
;;(put 'vc-next-action 'menu-enable 'vc-mode)
;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))

18
lisp/vc.el
View File

@ -242,7 +242,7 @@
;; already been reverted from a version backup, and this function
;; only needs to update the status of FILE within the backend.
;;
;; - cancel-version (file editable)
;; - rollback (file editable)
;;
;; Cancel the current workfile version of FILE, i.e. remove it from the
;; master. EDITABLE non-nil means that FILE should be writable
@ -588,7 +588,7 @@ to use -L and sets this variable to remember whether it worked."
:group 'vc)
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
if the local changes in the file have not been found and displayed yet."
:type '(choice (const :tag "No" nil)
@ -1274,7 +1274,7 @@ If VERBOSE is non-nil, query the user rather than using default parameters."
;; DO NOT revert the file without asking the user!
(if (not visited) (find-file-other-window file))
(if (yes-or-no-p "Revert to master version? ")
(vc-revert-buffer)))
(vc-revert)))
(t ;; normal action
(if (not verbose)
(vc-checkin file nil comment)
@ -2534,7 +2534,7 @@ it if their logs are not in RCS format."
(delete-region (match-beginning 0) (match-end 0)))))
;;;###autoload
(defun vc-revert-buffer ()
(defun vc-revert ()
"Revert the current buffer's file to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version. This function does not automatically pick up newer
@ -2593,7 +2593,7 @@ the current branch are merged into the working file."
(if (eq (vc-state file) 'edited)
(error
(substitute-command-keys
"File is locked--type \\[vc-revert-buffer] to discard changes"))
"File is locked--type \\[vc-revert] to discard changes"))
(error
(substitute-command-keys
"Unexpected file state (%s)--type \\[vc-next-action] to correct")
@ -2659,7 +2659,7 @@ return its name; otherwise return nil."
(vc-resynch-buffer file t t))
;;;###autoload
(defun vc-cancel-version (norevert)
(defun vc-rollback (norevert)
"Get rid of most recently checked in version of this file.
A prefix argument NOREVERT means do not revert the buffer afterwards."
(interactive "P")
@ -2668,12 +2668,12 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
(backend (vc-backend file))
(target (vc-workfile-version file)))
(cond
((not (vc-find-backend-function backend 'cancel-version))
((not (vc-find-backend-function backend 'rollback))
(error "Sorry, canceling versions is not supported under %s" backend))
((not (vc-call latest-on-branch-p file))
(error "This is not the latest version; VC cannot cancel it"))
((not (vc-up-to-date-p file))
(error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
(error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert] to discard changes"))))
(if (null (yes-or-no-p (format "Remove version %s from master? " target)))
(error "Aborted")
(setq norevert (or norevert (not
@ -2682,7 +2682,7 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
(message "Removing last change from %s..." file)
(with-vc-properties
file
(vc-call cancel-version file norevert)
(vc-call rollback file norevert)
`((vc-state . ,(if norevert 'edited 'up-to-date))
(vc-checkout-time . ,(if norevert
0