emacs: lisp/vc.el comparison

comparison lisp/vc.el @ 40958:4b4504c5aa56

* vc.el (vc-print-log): Bind `inhibit-read-only' to t before and set-buffer-modified-p to nil after `vc-exec-after'. * log-view.el (log-view-mode-map): Bind "q", "z", "m" and "d". (log-view-mode): Make read-only. (log-view-current-file): Do final `expand-file-name' in the current `default-directory'. (log-view-current-tag): Take an optional `where' arg. (log-view-diff): New user command.

author	Sam Steingold <sds@gnu.org>
date	Mon, 12 Nov 2001 23:01:17 +0000
parents	f5a9c609626a
children	cb1ebde1c4c9

comparison

equal deleted inserted replaced

-:721d19071a5f
+:4b4504c5aa56
 ;; Author:     FSF (see below for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 ;; Keywords: tools
-;; $Id: vc.el,v 1.317 2001/10/29 12:26:15 spiegel Exp $
+;; $Id: vc.el,v 1.318 2001/11/09 14:55:52 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
 ;; do not generally need to be aware of these properties.  For example,
 ;; `vc-sys-workfile-version' should compute the workfile version and
 ;; return it; it should not look it up in the property, and it needn't
 ;; store it there either.  However, if a backend-specific function does
 ;; store a value in a property, that value takes precedence over any
 ;; value that the generic code might want to set (check for uses of
 ;; the macro `with-vc-properties' in vc.el).
 ;;
 ;; In the list of functions below, each identifier needs to be prepended
 ;; with `vc-sys-'.  Some of the functions are mandatory (marked with a
 ;; `*'), others are optional (`-').
 ;;
 ;; * registered (file)
 ;;
 ;;   Return non-nil if FILE is registered in this backend.
 ;;
 ;; * state (file)
 ;;
 ;;   Return the current version control state of FILE.  For a list of
 ;;   possible values, see `vc-state'.  This function should do a full and
 ;;   reliable state computation; it is usually called immediately after
 ;;   C-x v v.  If you want to use a faster heuristic when visiting a
 ;;   pass the value of (vc-diff-switches-list BACKEND) to the backend
 ;;   command.  It should return a status of either 0 (no differences
 ;;   found), or 1 (either non-empty diff or the diff is run
 ;;   asynchronously).
 ;;
 ;; - diff-tree (dir &optional rev1 rev2)
 ;;
 ;;   Insert the diff for all files at and below DIR into the *vc-diff*
 ;;   buffer.  The meaning of REV1 and REV2 is the same as for
 ;;   vc-BACKEND-diff.  The default implementation does an explicit tree
 ;;   walk, calling vc-BACKEND-diff for each individual file.
 ;;
 ;; - annotate-command (file buf rev)
 ;;
 (260. . "#00FFA1")
 (280. . "#00FFD9")
 (300. . "#00EEFF")
 (320. . "#00B6FF")
 (340. . "#007EFF"))
 "*ASSOCIATION list of age versus color, for \\[vc-annotate].
 Ages are given in units of fractional days.  Default is eighteen steps
 using a twenty day increment."
 :type 'alist
 :group 'vc)
 (defun vc-default-workfile-unchanged-p (backend file)
 "Default check whether FILE is unchanged: diff against master version."
 (zerop (vc-call diff file (vc-workfile-version file))))
 (defun vc-default-latest-on-branch-p (backend file)
 "Default check whether the current workfile version of FILE is the
 latest on its branch."
 t)
 (defun vc-recompute-state (file)
 "Force a recomputation of the version control state of FILE.
 (list (file-relative-name file-rel1)
 (file-relative-name file-rel2))))
 (vc-call diff file rel1 rel2))))
 (defmacro vc-diff-switches-list (backend)
 "Make a list of `diff-switches', `vc-diff-switches',
 and `vc-BACKEND-diff-switches'."
 `(append
 (if (listp diff-switches) diff-switches (list diff-switches))
 (if (listp vc-diff-switches) vc-diff-switches (list vc-diff-switches))
 (let ((backend-switches
 (eval (intern (concat "vc-" (symbol-name ',backend)
 "-diff-switches")))))
 (if (listp backend-switches) backend-switches (list backend-switches)))))
 (defun vc-default-diff-tree (backend dir rel1 rel2)
 "Default implementation for diffing an entire tree at and below DIR.
 The meaning of REL1 and REL2 is the same as for `vc-version-diff'."
 ;; This implementation does an explicit tree walk, and calls
 ;; vc-BACKEND-diff directly for each file.  An optimization
 ;; would be to use `vc-diff-internal', so that diffs can be local,
 ;; and to call it only for files that are actually changed.
 ;; However, this is expensive for some backends, and so it is left
 ;; to backend-specific implementations.
 (setq default-directory dir)
 (vc-file-tree-walk
 default-directory
 (lambda (f)
 (vc-exec-after
 `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
 (message "Looking at %s" ',f)
 (vc-call-backend ',(vc-backend f)
 'diff ',f ',rel1 ',rel2))))))
 (defun vc-coding-system-for-diff (file)
 "Return the coding system for reading diff output for FILE."
 (or coding-system-for-read
 ;; if we already have this file open,
 ;; use the buffer's coding system
 (let ((buf (find-buffer-visiting file)))
 (if buf (with-current-buffer buf
 buffer-file-coding-system)))
 ;; otherwise, try to find one based on the file name
 (vc-call print-log file)
 (set-buffer "*vc*")
 (pop-to-buffer (current-buffer))
 (if (fboundp 'log-view-mode) (log-view-mode))
 (vc-exec-after
-`(progn
+`(let ((inhibit-read-only t))
 	(goto-char (point-max)) (forward-line -1)
 	(while (looking-at "=*\n")
 	  (delete-char (- (match-end 0) (match-beginning 0)))
 	  (forward-line -1))
 	(goto-char (point-min))
 	(if (fboundp 'log-view-goto-rev)
 	    (log-view-goto-rev ',(vc-workfile-version file))
 	  (if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
 	      (vc-call-backend ',(vc-backend file)
 			       'show-log-entry
-			       ',(vc-workfile-version file))))))))
+			       ',(vc-workfile-version file))))
+(set-buffer-modified-p nil)))))
 (defun vc-default-comment-history (backend file)
 "Return a string with all log entries that were made under BACKEND for FILE."
 (if (vc-find-backend-function backend 'print-log)
 (with-temp-buffer
 (defun vc-annotate-display-default (&optional ratio)
 "Use the default color spectrum for VC Annotate mode, scaling the
 colormap by RATIO, if present.  Use the current time as offset."
 (interactive "e")
 (message "Redisplaying annotation...")
 (vc-annotate-display
 (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
 (message "Redisplaying annotation...done"))
 (defun vc-annotate-display-autoscale (&optional full)
 "Re-display annotation using colormap scaled from the current time
 	(if (< date oldest)
 	    (setq oldest date))))
 (vc-annotate-display
 (vc-annotate-time-span		;return the scaled colormap.
 vc-annotate-color-map
 (/ (-  (if full newest current) oldest)
 	 (vc-annotate-car-last-cons vc-annotate-color-map)))
 (if full newest))
 (message "Redisplaying annotation...done \(%s\)"
 	     (if full
 		 (format "Spanned from %.1f to %.1f days old"
 			 (- current oldest)
 			 (- current newest))
 	       (format "Spanned to %.1f days old" (- current oldest))))))
 ;; Menu -- Using easymenu.el
 	(oldest-in-map (vc-annotate-car-last-cons vc-annotate-color-map)))
 (while menu-elements
 (let* ((element (car menu-elements))
 	     (days (* element oldest-in-map)))
 	(setq menu-elements (cdr menu-elements))
 	(setq menu-def
 	      (append menu-def
 		      `([,(format "Span %.1f days" days)
 			 (unless (and (numberp vc-annotate-display-mode)
 				      (= vc-annotate-display-mode ,days))
 			   (vc-annotate-display-select nil ,days))
 			 :style toggle :selected
 			 (and (numberp vc-annotate-display-mode)
 			      (= vc-annotate-display-mode ,days)) ])))))
 (setq menu-def
 	  (append menu-def
 		  (list
 		   ["Span ..."
 		    (let ((days
 			   (float (string-to-number
 				   (read-string "Span how many days? ")))))
 		      (vc-annotate-display-select nil days)) t])
 		  (list "--")
 		  (list
 		   ["Span to Oldest"
 		    (unless (eq vc-annotate-display-mode 'scale)
 		      (vc-annotate-display-select nil 'scale))
 		    :style toggle :selected
 		    (eq vc-annotate-display-mode 'scale)])
 		  (list
 		   ["Span Oldest->Newest"
 		    (unless (eq vc-annotate-display-mode 'fullscale)
 		      (vc-annotate-display-select nil 'fullscale))
 		    :style toggle :selected
 		    (eq vc-annotate-display-mode 'fullscale)])))
 ;; Define the menu
 (if (or (featurep 'easymenu) (load "easymenu" t))
 	(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
 			  "VC Annotate Display Menu" menu-def))))
 (defun vc-annotate-display-select (&optional buffer mode)
 "Do the default or chosen annotation display as specified in the
 customizable variable `vc-annotate-display-mode'."
 (when buffer
 (set-buffer buffer)
 (display-buffer buffer))
 (if (not vc-annotate-mode)		; Turn on vc-annotate-mode if not done
 (vc-annotate-mode))
 (cond ((null vc-annotate-display-mode) (vc-annotate-display-default
 					  vc-annotate-ratio))
 	((symbolp vc-annotate-display-mode) ; One of the auto-scaling modes
 	 (cond ((eq vc-annotate-display-mode 'scale)
 		(vc-annotate-display-autoscale))
 	       ((eq vc-annotate-display-mode 'fullscale)
 		(vc-annotate-display-autoscale t))
 	       (t (error "No such display mode: %s"
 			 vc-annotate-display-mode))))
 	((numberp vc-annotate-display-mode) ; A fixed number of days lookback
 	 (vc-annotate-display-default
 	  (/ vc-annotate-display-mode (vc-annotate-car-last-cons
 				       vc-annotate-color-map))))
 	(t (error "Error in display mode select"))))
 ;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
 ;;;;  Execute "annotate" on FILE by using `call-process' and insert
 (interactive "P")
 (vc-ensure-vc-buffer)
 (let* ((temp-buffer-name (concat "*Annotate " (buffer-name) "*"))
 (temp-buffer-show-function 'vc-annotate-display-select)
 (rev (vc-workfile-version (buffer-file-name)))
 (vc-annotate-version
 (if prefix (read-string
 (format "Annotate from version: (default %s) " rev)
 nil nil rev)
 rev)))
 (if prefix
 (setq vc-annotate-display-mode
 (float (string-to-number
 (read-string "Annotate span days: (default 20) "
 nil nil "20")))))
 (setq vc-annotate-backend (vc-backend (buffer-file-name)))
 (message "Annotating...")
 (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
 	(error "Sorry, annotating is not implemented for %s"
 "Calculate the difference, in days, from the current time and the
 time returned from the backend function annotate-time.  If OFFSET is
 set, use it as the time base instead of the current time."
 (let ((next-time (vc-call-backend vc-annotate-backend 'annotate-time)))
 (if next-time
 	 (- (or offset
 		(vc-call-backend vc-annotate-backend 'annotate-current-time))
 	    next-time))))
 (defun vc-default-annotate-current-time (backend)
 "Return the current time, encoded as fractional days."
 (vc-annotate-convert-time (current-time)))
 (defun vc-annotate-display (&optional color-map offset)
 "Do the VC-Annotate display in BUFFER using COLOR-MAP, and time
 offset OFFSET (defaults to the present time).  You probably want
 `vc-annotate-select' instead, after setting
 `vc-annotate-display-mode'"
 	   ;; Make the face if not done.
 	   (face (or (intern-soft face-name)
 		     (let ((tmp-face (make-face (intern face-name))))
 		       (set-face-foreground tmp-face (cdr color))
 		       (if vc-annotate-background
 			     (set-face-background tmp-face
 						  vc-annotate-background))
 		       tmp-face)))	; Return the face
 	   (point (point))
 	   overlay)
 	(forward-line 1)

Mercurial > emacs

comparison lisp/vc.el @ 40958:4b4504c5aa56