;;; vc-hooks.el --- resident support for version-control
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Modified by:
(looking-at "[^ ]+ \\([0-9.]+\\) ")))
(goto-char (match-end 0))
;; if found, store the revision number ...
- (setq version (buffer-substring (match-beginning 1) (match-end 1)))
+ (setq version (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
;; ... and check for the locking state
(cond
((looking-at
;; revision is locked by some user
((looking-at "\\([^ ]+\\) \\$")
(setq locking-user
- (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
(setq status 'rev-and-lock))
;; everything else: false
(nil)))
"Revision: \\([0-9.]+\\) \\$")
nil t)
;; if found, store the revision number ...
- (setq version (buffer-substring (match-beginning 1) (match-end 1)))
+ (setq version (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
;; and see if there's any lock information
(goto-char (point-min))
(if (re-search-forward (concat "\\$" "Locker:") nil t)
(cond ((looking-at " \\([^ ]+\\) \\$")
- (setq locking-user (buffer-substring (match-beginning 1)
- (match-end 1)))
+ (setq locking-user (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1)))
(setq status 'rev-and-lock))
((looking-at " *\\$")
(setq locking-user 'none)
vc-master-templates)
nil)))))
-(defun vc-utc-string (timeval)
- ;; Convert a time value into universal time, and return it as a
- ;; human-readable string. This is for comparing CVS checkout times
- ;; with file modification times.
- (let (utc (high (car timeval)) (low (nth 1 timeval))
- (offset (car (current-time-zone timeval))))
- (setq low (- low offset))
- (setq utc (if (> low 65535)
- (list (1+ high) (- low 65536))
- (if (< low 0)
- (list (1- high) (+ 65536 low))
- (list high low))))
- (current-time-string utc)))
-
(defun vc-find-cvs-master (dirname basename)
;; Check if DIRNAME/BASENAME is handled by CVS.
;; If it is, do a (throw 'found (cons MASTER 'CVS)).
(cond
((re-search-forward
(concat "^/" (regexp-quote basename)
- "/\\([^/]*\\)/\\([^/]*\\)/")
+ "/\\([^/]*\\)/[^ /]* \\([A-Z][a-z][a-z]\\) *\\([0-9]*\\) \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\) \\([0-9]*\\)")
nil t)
(setq case-fold-search fold) ;; restore the old value
;; We found it. Store away version number now that we
(match-string 1))
;; If the file hasn't been modified since checkout,
;; store the checkout-time.
- (let ((mtime (nth 5 (file-attributes file))))
- (if (string= (match-string 2) (vc-utc-string mtime))
+ (let ((mtime (nth 5 (file-attributes file)))
+ (second (string-to-number (match-string 6)))
+ (minute (string-to-number (match-string 5)))
+ (hour (string-to-number (match-string 4)))
+ (day (string-to-number (match-string 3)))
+ (year (string-to-number (match-string 7))))
+ (if (equal mtime
+ (encode-time
+ second minute hour day
+ (/ (string-match
+ (match-string 2)
+ "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
+ 3)
+ year 0))
(vc-file-setprop file 'vc-checkout-time mtime)
(vc-file-setprop file 'vc-checkout-time 0)))
(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
(t
(concat ":" locker ":" rev)))))
+(defun vc-follow-link ()
+ ;; If the current buffer visits a symbolic link, this function makes it
+ ;; visit the real file instead. If the real file is already visited in
+ ;; another buffer, make that buffer current, and kill the buffer
+ ;; that visits the link.
+ (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
+ (true-buffer (find-buffer-visiting truename))
+ (this-buffer (current-buffer)))
+ (if (eq true-buffer this-buffer)
+ (progn
+ (kill-buffer this-buffer)
+ ;; In principle, we could do something like set-visited-file-name.
+ ;; However, it can't be exactly the same as set-visited-file-name.
+ ;; I'm not going to work out the details right now. -- rms.
+ (set-buffer (find-file-noselect truename)))
+ (set-buffer true-buffer)
+ (kill-buffer this-buffer))))
+
;;; install a call to the above as a find-file hook
(defun vc-find-file-hook ()
;; Recompute whether file is version controlled,
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t))))
((let* ((link (file-symlink-p buffer-file-name))
- (link-type (and link (vc-backend link))))
+ (link-type (and link (vc-backend (file-chase-links link)))))
(if link-type
(cond ((eq vc-follow-symlinks nil)
(message
"Warning: symbolic link to %s-controlled source file" link-type))
- ((eq vc-follow-symlinks 'ask)
+ ((or (not (eq vc-follow-symlinks 'ask))
+ ;; If we already visited this file by following
+ ;; the link, don't ask again if we try to visit
+ ;; it again. GUD does that, and repeated questions
+ ;; are painful.
+ (get-file-buffer
+ (abbreviate-file-name (file-chase-links buffer-file-name))))
+
+ (vc-follow-link)
+ (message "Followed link to %s" buffer-file-name)
+ (vc-find-file-hook))
+ (t
(if (yes-or-no-p (format
"Symbolic link to %s-controlled source file; follow link? " link-type))
- (progn (setq buffer-file-name
- (file-truename buffer-file-name))
+ (progn (vc-follow-link)
(message "Followed link to %s" buffer-file-name)
(vc-find-file-hook))
(message
"Warning: editing through the link bypasses version control")
- ))
- (t (setq buffer-file-name (file-truename buffer-file-name))
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))))))))))
+ ))))))))))
(add-hook 'find-file-hooks 'vc-find-file-hook)
'("Insert Header" . vc-insert-headers))
(define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action))
(define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only))
- (define-key vc-menu-map [vc-register] '("Register" . vc-register))
- (put 'vc-rename-file 'menu-enable 'vc-mode)
- (put 'vc-version-other-window 'menu-enable 'vc-mode)
- (put 'vc-diff 'menu-enable 'vc-mode)
- (put 'vc-update-change-log 'menu-enable
- '(eq (vc-buffer-backend) 'RCS))
- (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-insert-headers 'menu-enable 'vc-mode)
- (put 'vc-next-action 'menu-enable '(and vc-mode (not buffer-read-only)))
- (put 'vc-toggle-read-only 'menu-enable '(and vc-mode buffer-read-only))
- (put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
- )
+ (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
+
+(put 'vc-rename-file 'menu-enable 'vc-mode)
+(put 'vc-version-other-window 'menu-enable 'vc-mode)
+(put 'vc-diff 'menu-enable 'vc-mode)
+(put 'vc-update-change-log 'menu-enable
+ '(eq (vc-buffer-backend) 'RCS))
+(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-insert-headers 'menu-enable 'vc-mode)
+(put 'vc-next-action 'menu-enable 'vc-mode)
+(put 'vc-toggle-read-only 'menu-enable 'vc-mode)
+(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
(provide 'vc-hooks)
HCoop / bpt / emacs.git / blobdiff