Mercurial > emacs

comparison lisp/vc-hooks.el @ 81958:55e9cc4986ff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Generalize stay-local-p to operatre on lists of files. Change two keybindings to point to new function names.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Wed, 18 Jul 2007 12:43:37 +0000
parents 184879170b16
children 733a82d712c8 a1be62cbd32a
comparison
equal deleted inserted replaced
81957:8f9991bf3b41 81958:55e9cc4986ff
158 :group 'vc) 158 :group 'vc)
159 159
160 (defun vc-stay-local-p (file) 160 (defun vc-stay-local-p (file)
161 "Return non-nil if VC should stay local when handling FILE. 161 "Return non-nil if VC should stay local when handling FILE.
162 This uses the `repository-hostname' backend operation." 162 This uses the `repository-hostname' backend operation."
163 (let* ((backend (vc-backend file)) 163 (if (listp file)
164 (sym (vc-make-backend-sym backend 'stay-local)) 164 (if (remove-if-not (lambda (x) (not (vc-stay-local-p x))) file) 'no 'yes)
165 (stay-local (if (boundp sym) (symbol-value sym) t))) 165 (let* ((backend (vc-backend file))
166 (if (eq stay-local t) (setq stay-local vc-stay-local)) 166 (sym (vc-make-backend-sym backend 'stay-local))
167 (if (symbolp stay-local) stay-local 167 (stay-local (if (boundp sym) (symbol-value sym) t)))
168 (let ((dirname (if (file-directory-p file) 168 (if (eq stay-local t) (setq stay-local vc-stay-local))
169 (directory-file-name file) 169 (if (symbolp stay-local) stay-local
170 (file-name-directory file)))) 170 (let ((dirname (if (file-directory-p file)
171 (eq 'yes 171 (directory-file-name file)
172 (or (vc-file-getprop dirname 'vc-stay-local-p) 172 (file-name-directory file))))
173 (vc-file-setprop 173 (eq 'yes
174 dirname 'vc-stay-local-p 174 (or (vc-file-getprop dirname 'vc-stay-local-p)
175 (let ((hostname (vc-call-backend 175 (vc-file-setprop
176 backend 'repository-hostname dirname))) 176 dirname 'vc-stay-local-p
177 (if (not hostname) 177 (let ((hostname (vc-call-backend
178 'no 178 backend 'repository-hostname dirname)))
179 (let ((default t)) 179 (if (not hostname)
180 (if (eq (car-safe stay-local) 'except) 180 'no
181 (setq default nil stay-local (cdr stay-local))) 181 (let ((default t))
182 (when (consp stay-local) 182 (if (eq (car-safe stay-local) 'except)
183 (setq stay-local 183 (setq default nil stay-local (cdr stay-local)))
184 (mapconcat 'identity stay-local "\\|"))) 184 (when (consp stay-local)
185 (if (if (string-match stay-local hostname) 185 (setq stay-local
186 default (not default)) 186 (mapconcat 'identity stay-local "\\|")))
187 'yes 'no))))))))))) 187 (if (if (string-match stay-local hostname)
188 default (not default))
189 'yes 'no))))))))))))
188 190
189 ;;; This is handled specially now. 191 ;;; This is handled specially now.
190 ;; Tell Emacs about this new kind of minor mode 192 ;; Tell Emacs about this new kind of minor mode
191 ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) 193 ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
192 194
371 (cons backend vc-handled-backends)))) 373 (cons backend vc-handled-backends))))
372 ;; File is not registered. 374 ;; File is not registered.
373 (vc-file-setprop file 'vc-backend 'none) 375 (vc-file-setprop file 'vc-backend 'none)
374 nil))))) 376 nil)))))
375 377
376 (defun vc-backend (file) 378 (defun vc-backend (file-or-list)
377 "Return the version control type of FILE, nil if it is not registered." 379 "Return the version control type of FILE-OR-LIST, nil if it's not registered.
380 If the argument is a list, the files must all have the same back end."
378 ;; `file' can be nil in several places (typically due to the use of 381 ;; `file' can be nil in several places (typically due to the use of
379 ;; code like (vc-backend buffer-file-name)). 382 ;; code like (vc-backend buffer-file-name)).
380 (when (stringp file) 383 (cond ((stringp file-or-list)
381 (let ((property (vc-file-getprop file 'vc-backend))) 384 (let ((property (vc-file-getprop file-or-list 'vc-backend)))
382 ;; Note that internally, Emacs remembers unregistered 385 ;; Note that internally, Emacs remembers unregistered
383 ;; files by setting the property to `none'. 386 ;; files by setting the property to `none'.
384 (cond ((eq property 'none) nil) 387 (cond ((eq property 'none) nil)
385 (property) 388 (property)
386 ;; vc-registered sets the vc-backend property 389 ;; vc-registered sets the vc-backend property
387 (t (if (vc-registered file) 390 (t (if (vc-registered file-or-list)
388 (vc-file-getprop file 'vc-backend) 391 (vc-file-getprop file-or-list 'vc-backend)
389 nil)))))) 392 nil)))))
393 ((and file-or-list (listp file-or-list))
394 (vc-backend (car file-or-list)))
395 (t
396 nil)))
397
390 398
391 (defun vc-backend-subdirectory-name (file) 399 (defun vc-backend-subdirectory-name (file)
392 "Return where the master and lock FILEs for the current directory are kept." 400 "Return where the master and lock FILEs for the current directory are kept."
393 (symbol-name (vc-backend file))) 401 (symbol-name (vc-backend file)))
394 402
478 ;; typically represented by vc-workfile-version = "0") 486 ;; typically represented by vc-workfile-version = "0")
479 ;; - `conflict' (i.e. `edited' with conflict markers) 487 ;; - `conflict' (i.e. `edited' with conflict markers)
480 ;; - `removed' 488 ;; - `removed'
481 ;; - `copied' and `moved' (might be handled by `removed' and `added') 489 ;; - `copied' and `moved' (might be handled by `removed' and `added')
482 (or (vc-file-getprop file 'vc-state) 490 (or (vc-file-getprop file 'vc-state)
483 (if (vc-backend file) 491 (if (and (> (length file) 0) (vc-backend file))
484 (vc-file-setprop file 'vc-state 492 (vc-file-setprop file 'vc-state
485 (vc-call state-heuristic file))))) 493 (vc-call state-heuristic file)))))
486 494
487 (defun vc-recompute-state (file) 495 (defun vc-recompute-state (file)
488 "Recompute the version control state of FILE, and return it. 496 "Recompute the version control state of FILE, and return it.
530 (not (eq (caddr err) 4))) 538 (not (eq (caddr err) 4)))
531 (signal (car err) (cdr err)) 539 (signal (car err) (cdr err))
532 (vc-call diff file)))))) 540 (vc-call diff file))))))
533 541
534 (defun vc-workfile-version (file) 542 (defun vc-workfile-version (file)
535 "Return the version level of the current workfile FILE. 543 "Return the repository version from which FILE was checked out.
536 If FILE is not registered, this function always returns nil." 544 If FILE is not registered, this function always returns nil."
537 (or (vc-file-getprop file 'vc-workfile-version) 545 (or (vc-file-getprop file 'vc-workfile-version)
538 (if (vc-backend file) 546 (if (vc-backend file)
539 (vc-file-setprop file 'vc-workfile-version 547 (vc-file-setprop file 'vc-workfile-version
540 (vc-call workfile-version file))))) 548 (vc-call workfile-version file)))))
871 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) 879 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
872 (defvar vc-prefix-map 880 (defvar vc-prefix-map
873 (let ((map (make-sparse-keymap))) 881 (let ((map (make-sparse-keymap)))
874 (define-key map "a" 'vc-update-change-log) 882 (define-key map "a" 'vc-update-change-log)
875 (define-key map "b" 'vc-switch-backend) 883 (define-key map "b" 'vc-switch-backend)
876 (define-key map "c" 'vc-cancel-version) 884 (define-key map "c" 'vc-rollback)
877 (define-key map "d" 'vc-directory) 885 (define-key map "d" 'vc-directory)
878 (define-key map "g" 'vc-annotate) 886 (define-key map "g" 'vc-annotate)
879 (define-key map "h" 'vc-insert-headers) 887 (define-key map "h" 'vc-insert-headers)
880 (define-key map "i" 'vc-register) 888 (define-key map "i" 'vc-register)
881 (define-key map "l" 'vc-print-log) 889 (define-key map "l" 'vc-print-log)
882 (define-key map "m" 'vc-merge) 890 (define-key map "m" 'vc-merge)
883 (define-key map "r" 'vc-retrieve-snapshot) 891 (define-key map "r" 'vc-retrieve-snapshot)
884 (define-key map "s" 'vc-create-snapshot) 892 (define-key map "s" 'vc-create-snapshot)
885 (define-key map "u" 'vc-revert-buffer) 893 (define-key map "u" 'vc-revert)
886 (define-key map "v" 'vc-next-action) 894 (define-key map "v" 'vc-next-action)
895 (define-key map "+" 'vc-update)
887 (define-key map "=" 'vc-diff) 896 (define-key map "=" 'vc-diff)
888 (define-key map "~" 'vc-version-other-window) 897 (define-key map "~" 'vc-version-other-window)
889 map)) 898 map))
890 (fset 'vc-prefix-map vc-prefix-map) 899 (fset 'vc-prefix-map vc-prefix-map)
891 (define-key global-map "\C-xv" 'vc-prefix-map) 900 (define-key global-map "\C-xv" 'vc-prefix-map)
911 '("Update ChangeLog" . vc-update-change-log)) 920 '("Update ChangeLog" . vc-update-change-log))
912 (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log)) 921 (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
913 (define-key vc-menu-map [separator2] '("----")) 922 (define-key vc-menu-map [separator2] '("----"))
914 (define-key vc-menu-map [vc-insert-header] 923 (define-key vc-menu-map [vc-insert-header]
915 '("Insert Header" . vc-insert-headers)) 924 '("Insert Header" . vc-insert-headers))
916 (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) 925 (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-rollback))
917 (define-key vc-menu-map [vc-revert-buffer] 926 (define-key vc-menu-map [vc-revert]
918 '("Revert to Base Version" . vc-revert-buffer)) 927 '("Revert to Base Version" . vc-revert))
919 (define-key vc-menu-map [vc-update] 928 (define-key vc-menu-map [vc-update]
920 '("Update to Latest Version" . vc-update)) 929 '("Update to Latest Version" . vc-update))
921 (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action)) 930 (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
922 (define-key vc-menu-map [vc-register] '("Register" . vc-register))) 931 (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
923 932
930 ;;(put 'vc-version-other-window 'menu-enable 'vc-mode) 939 ;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
931 ;;(put 'vc-diff 'menu-enable 'vc-mode) 940 ;;(put 'vc-diff 'menu-enable 'vc-mode)
932 ;;(put 'vc-update-change-log 'menu-enable 941 ;;(put 'vc-update-change-log 'menu-enable
933 ;; '(member (vc-buffer-backend) '(RCS CVS))) 942 ;; '(member (vc-buffer-backend) '(RCS CVS)))
934 ;;(put 'vc-print-log 'menu-enable 'vc-mode) 943 ;;(put 'vc-print-log 'menu-enable 'vc-mode)
935 ;;(put 'vc-cancel-version 'menu-enable 'vc-mode) 944 ;;(put 'vc-rollback 'menu-enable 'vc-mode)
936 ;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) 945 ;;(put 'vc-revert 'menu-enable 'vc-mode)
937 ;;(put 'vc-insert-headers 'menu-enable 'vc-mode) 946 ;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
938 ;;(put 'vc-next-action 'menu-enable 'vc-mode) 947 ;;(put 'vc-next-action 'menu-enable 'vc-mode)
939 ;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) 948 ;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
940 949
941 (provide 'vc-hooks) 950 (provide 'vc-hooks)