Mercurial > emacs
changeset 94579:dca2377770e7
Move context-preservation machinery.
| author | Eric S. Raymond <esr@snark.thyrsus.com> |
|---|---|
| date | Sat, 03 May 2008 10:18:08 +0000 |
| parents | 7bfee6b6aa8d |
| children | 9a020be031da |
| files | lisp/vc-dispatcher.el lisp/vc.el |
| diffstat | 2 files changed, 199 insertions(+), 245 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/vc-dispatcher.el Sat May 03 10:17:22 2008 +0000 +++ b/lisp/vc-dispatcher.el Sat May 03 10:18:08 2008 +0000 @@ -85,7 +85,21 @@ :type 'hook :group 'vc) +(defcustom vc-delete-logbuf-window t + "If non-nil, delete the *VC-log* buffer and window after each logical action. +If nil, bury that buffer instead. +This is most useful if you have multiple windows on a frame and would like to +preserve the setting." + :type 'boolean + :group 'vc) + +(defcustom vc-command-messages nil + "If non-nil, display run messages from back-end commands." + :type 'boolean + :group 'vc) + ;; Variables the user doesn't need to know about. + (defvar vc-log-operation nil) (defvar vc-log-after-operation-hook nil) (defvar vc-log-fileset) @@ -310,6 +324,187 @@ ',command ',file-or-list ',flags)) status)))) +;; These functions are used to ensure that the view the user sees is up to date +;; even if the dispatcher client mode has messed with file contents (as in, +;; for example, VCS keyword expansion). + +(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win)) + +(defun vc-position-context (posn) + "Save a bit of the text around POSN in the current buffer. +Used to help us find the corresponding position again later +if markers are destroyed or corrupted." + ;; A lot of this was shamelessly lifted from Sebastian Kremer's + ;; rcs.el mode. + (list posn + (buffer-size) + (buffer-substring posn + (min (point-max) (+ posn 100))))) + +(defun vc-find-position-by-context (context) + "Return the position of CONTEXT in the current buffer. +If CONTEXT cannot be found, return nil." + (let ((context-string (nth 2 context))) + (if (equal "" context-string) + (point-max) + (save-excursion + (let ((diff (- (nth 1 context) (buffer-size)))) + (when (< diff 0) (setq diff (- diff))) + (goto-char (nth 0 context)) + (if (or (search-forward context-string nil t) + ;; Can't use search-backward since the match may continue + ;; after point. + (progn (goto-char (- (point) diff (length context-string))) + ;; goto-char doesn't signal an error at + ;; beginning of buffer like backward-char would + (search-forward context-string nil t))) + ;; to beginning of OSTRING + (- (point) (length context-string)))))))) + +(defun vc-context-matches-p (posn context) + "Return t if POSN matches CONTEXT, nil otherwise." + (let* ((context-string (nth 2 context)) + (len (length context-string)) + (end (+ posn len))) + (if (> end (1+ (buffer-size))) + nil + (string= context-string (buffer-substring posn end))))) + +(defun vc-buffer-context () + "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE). +Used by `vc-restore-buffer-context' to later restore the context." + (let ((point-context (vc-position-context (point))) + ;; Use mark-marker to avoid confusion in transient-mark-mode. + (mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer)) + (vc-position-context (mark-marker)))) + ;; Make the right thing happen in transient-mark-mode. + (mark-active nil) + ;; The new compilation code does not use compilation-error-list any + ;; more, so the code below is now ineffective and might as well + ;; be disabled. -- Stef + ;; ;; We may want to reparse the compilation buffer after revert + ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded + ;; ;; Construct a list; each elt is nil or a buffer + ;; ;; if that buffer is a compilation output buffer + ;; ;; that contains markers into the current buffer. + ;; (save-current-buffer + ;; (mapcar (lambda (buffer) + ;; (set-buffer buffer) + ;; (let ((errors (or + ;; compilation-old-error-list + ;; compilation-error-list)) + ;; (buffer-error-marked-p nil)) + ;; (while (and (consp errors) + ;; (not buffer-error-marked-p)) + ;; (and (markerp (cdr (car errors))) + ;; (eq buffer + ;; (marker-buffer + ;; (cdr (car errors)))) + ;; (setq buffer-error-marked-p t)) + ;; (setq errors (cdr errors))) + ;; (if buffer-error-marked-p buffer))) + ;; (buffer-list))))) + (reparse nil)) + (list point-context mark-context reparse))) + +(defun vc-restore-buffer-context (context) + "Restore point/mark, and reparse any affected compilation buffers. +CONTEXT is that which `vc-buffer-context' returns." + (let ((point-context (nth 0 context)) + (mark-context (nth 1 context)) + ;; (reparse (nth 2 context)) + ) + ;; The new compilation code does not use compilation-error-list any + ;; more, so the code below is now ineffective and might as well + ;; be disabled. -- Stef + ;; ;; Reparse affected compilation buffers. + ;; (while reparse + ;; (if (car reparse) + ;; (with-current-buffer (car reparse) + ;; (let ((compilation-last-buffer (current-buffer)) ;select buffer + ;; ;; Record the position in the compilation buffer of + ;; ;; the last error next-error went to. + ;; (error-pos (marker-position + ;; (car (car-safe compilation-error-list))))) + ;; ;; Reparse the error messages as far as they were parsed before. + ;; (compile-reinitialize-errors '(4) compilation-parsing-end) + ;; ;; Move the pointer up to find the error we were at before + ;; ;; reparsing. Now next-error should properly go to the next one. + ;; (while (and compilation-error-list + ;; (/= error-pos (car (car compilation-error-list)))) + ;; (setq compilation-error-list (cdr compilation-error-list)))))) + ;; (setq reparse (cdr reparse))) + + ;; if necessary, restore point and mark + (if (not (vc-context-matches-p (point) point-context)) + (let ((new-point (vc-find-position-by-context point-context))) + (when new-point (goto-char new-point)))) + (and mark-active + mark-context + (not (vc-context-matches-p (mark) mark-context)) + (let ((new-mark (vc-find-position-by-context mark-context))) + (when new-mark (set-mark new-mark)))))) + +(defun vc-revert-buffer-internal (&optional arg no-confirm) + "Revert buffer, keeping point and mark where user expects them. +Try to be clever in the face of changes due to expanded version-control +key words. This is important for typeahead to work as expected. +ARG and NO-CONFIRM are passed on to `revert-buffer'." + (interactive "P") + (widen) + (let ((context (vc-buffer-context))) + ;; Use save-excursion here, because it may be able to restore point + ;; and mark properly even in cases where vc-restore-buffer-context + ;; would fail. However, save-excursion might also get it wrong -- + ;; in this case, vc-restore-buffer-context gives it a second try. + (save-excursion + ;; t means don't call normal-mode; + ;; that's to preserve various minor modes. + (revert-buffer arg no-confirm t)) + (vc-restore-buffer-context context))) + +(defun vc-resynch-window (file &optional keep noquery) + "If FILE is in the current buffer, either revert or unvisit it. +The choice between revert (to see expanded keywords) and unvisit +depends on KEEP. NOQUERY if non-nil inhibits confirmation for +reverting. NOQUERY should be t *only* if it is known the only +difference between the buffer and the file is due to +modifications by the dispatcher client code, rather than user +editing!" + (and (string= buffer-file-name file) + (if keep + (progn + (vc-revert-buffer-internal t noquery) + ;; TODO: Adjusting view mode might no longer be necessary + ;; after RMS change to files.el of 1999-08-08. Investigate + ;; this when we install the new VC. + (and view-read-only + (if (file-writable-p file) + (and view-mode + (let ((view-old-buffer-read-only nil)) + (view-mode-exit))) + (and (not view-mode) + (not (eq (get major-mode 'mode-class) 'special)) + (view-mode-enter)))) + ;; FIXME: Call into vc.el + (vc-mode-line buffer-file-name)) + (kill-buffer (current-buffer))))) + +(defun vc-resynch-buffer (file &optional keep noquery) + "If FILE is currently visited, resynch its buffer." + (if (string= buffer-file-name file) + (vc-resynch-window file keep noquery) + (let ((buffer (get-file-buffer file))) + (when buffer + (with-current-buffer buffer + (vc-resynch-window file keep noquery))))) + ;; FIME: Call into vc.el + (vc-directory-resynch-file file) + (when (memq 'vc-dir-mark-buffer-changed after-save-hook) + (let ((buffer (get-file-buffer file))) + ;; FIME: Call into vc.el + (vc-dir-mark-buffer-changed file)))) + ;; Command closures (defun vc-start-logentry (files extra comment initial-contents msg action &optional after-hook) @@ -331,18 +526,12 @@ (if (and files (equal (length files) 1)) (get-file-buffer (car files)) (current-buffer))))) - (when vc-before-checkin-hook - (if files - (with-current-buffer parent - (run-hooks 'vc-before-checkin-hook)) - (run-hooks 'vc-before-checkin-hook))) (if (and comment (not initial-contents)) (set-buffer (get-buffer-create "*VC-log*")) (pop-to-buffer (get-buffer-create "*VC-log*"))) (set (make-local-variable 'vc-parent-buffer) parent) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name vc-parent-buffer))) - ;;(if file (vc-mode-line file)) (vc-log-edit files) (make-local-variable 'vc-log-after-operation-hook) (when after-hook @@ -401,11 +590,11 @@ (mapc (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t)) log-fileset)) + ;; FIXME: Call into vc.el (when vc-dired-mode (dired-move-to-filename)) (when (eq major-mode 'vc-dir-mode) (vc-dir-move-to-goal-column)) (run-hooks after-hook 'vc-finish-logentry-hook))) - ;;; vc-dispatcher.el ends here
--- a/lisp/vc.el Sat May 03 10:17:22 2008 +0000 +++ b/lisp/vc.el Sat May 03 10:18:08 2008 +0000 @@ -714,14 +714,6 @@ :type 'boolean :group 'vc) -(defcustom vc-delete-logbuf-window t - "If non-nil, delete the *VC-log* buffer and window after each logical action. -If nil, bury that buffer instead. -This is most useful if you have multiple windows on a frame and would like to -preserve the setting." - :type 'boolean - :group 'vc) - (defcustom vc-initial-comment nil "If non-nil, prompt for initial comment when a file is registered." :type 'boolean @@ -735,11 +727,6 @@ :group 'vc :version "20.3") -(defcustom vc-command-messages nil - "If non-nil, display run messages from back-end commands." - :type 'boolean - :group 'vc) - (defcustom vc-checkin-switches nil "A string or list of strings specifying extra switches for checkin. These are passed to the checkin program by \\[vc-checkin]." @@ -1054,121 +1041,6 @@ ,@body (save-buffer))))) -(defun vc-position-context (posn) - "Save a bit of the text around POSN in the current buffer. -Used to help us find the corresponding position again later -if markers are destroyed or corrupted." - ;; A lot of this was shamelessly lifted from Sebastian Kremer's - ;; rcs.el mode. - (list posn - (buffer-size) - (buffer-substring posn - (min (point-max) (+ posn 100))))) - -(defun vc-find-position-by-context (context) - "Return the position of CONTEXT in the current buffer. -If CONTEXT cannot be found, return nil." - (let ((context-string (nth 2 context))) - (if (equal "" context-string) - (point-max) - (save-excursion - (let ((diff (- (nth 1 context) (buffer-size)))) - (when (< diff 0) (setq diff (- diff))) - (goto-char (nth 0 context)) - (if (or (search-forward context-string nil t) - ;; Can't use search-backward since the match may continue - ;; after point. - (progn (goto-char (- (point) diff (length context-string))) - ;; goto-char doesn't signal an error at - ;; beginning of buffer like backward-char would - (search-forward context-string nil t))) - ;; to beginning of OSTRING - (- (point) (length context-string)))))))) - -(defun vc-context-matches-p (posn context) - "Return t if POSN matches CONTEXT, nil otherwise." - (let* ((context-string (nth 2 context)) - (len (length context-string)) - (end (+ posn len))) - (if (> end (1+ (buffer-size))) - nil - (string= context-string (buffer-substring posn end))))) - -(defun vc-buffer-context () - "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE). -Used by `vc-restore-buffer-context' to later restore the context." - (let ((point-context (vc-position-context (point))) - ;; Use mark-marker to avoid confusion in transient-mark-mode. - (mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer)) - (vc-position-context (mark-marker)))) - ;; Make the right thing happen in transient-mark-mode. - (mark-active nil) - ;; The new compilation code does not use compilation-error-list any - ;; more, so the code below is now ineffective and might as well - ;; be disabled. -- Stef - ;; ;; We may want to reparse the compilation buffer after revert - ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded - ;; ;; Construct a list; each elt is nil or a buffer - ;; ;; if that buffer is a compilation output buffer - ;; ;; that contains markers into the current buffer. - ;; (save-current-buffer - ;; (mapcar (lambda (buffer) - ;; (set-buffer buffer) - ;; (let ((errors (or - ;; compilation-old-error-list - ;; compilation-error-list)) - ;; (buffer-error-marked-p nil)) - ;; (while (and (consp errors) - ;; (not buffer-error-marked-p)) - ;; (and (markerp (cdr (car errors))) - ;; (eq buffer - ;; (marker-buffer - ;; (cdr (car errors)))) - ;; (setq buffer-error-marked-p t)) - ;; (setq errors (cdr errors))) - ;; (if buffer-error-marked-p buffer))) - ;; (buffer-list))))) - (reparse nil)) - (list point-context mark-context reparse))) - -(defun vc-restore-buffer-context (context) - "Restore point/mark, and reparse any affected compilation buffers. -CONTEXT is that which `vc-buffer-context' returns." - (let ((point-context (nth 0 context)) - (mark-context (nth 1 context)) - ;; (reparse (nth 2 context)) - ) - ;; The new compilation code does not use compilation-error-list any - ;; more, so the code below is now ineffective and might as well - ;; be disabled. -- Stef - ;; ;; Reparse affected compilation buffers. - ;; (while reparse - ;; (if (car reparse) - ;; (with-current-buffer (car reparse) - ;; (let ((compilation-last-buffer (current-buffer)) ;select buffer - ;; ;; Record the position in the compilation buffer of - ;; ;; the last error next-error went to. - ;; (error-pos (marker-position - ;; (car (car-safe compilation-error-list))))) - ;; ;; Reparse the error messages as far as they were parsed before. - ;; (compile-reinitialize-errors '(4) compilation-parsing-end) - ;; ;; Move the pointer up to find the error we were at before - ;; ;; reparsing. Now next-error should properly go to the next one. - ;; (while (and compilation-error-list - ;; (/= error-pos (car (car compilation-error-list)))) - ;; (setq compilation-error-list (cdr compilation-error-list)))))) - ;; (setq reparse (cdr reparse))) - - ;; if necessary, restore point and mark - (if (not (vc-context-matches-p (point) point-context)) - (let ((new-point (vc-find-position-by-context point-context))) - (when new-point (goto-char new-point)))) - (and mark-active - mark-context - (not (vc-context-matches-p (mark) mark-context)) - (let ((new-mark (vc-find-position-by-context mark-context))) - (when new-mark (set-mark new-mark)))))) - ;;; Code for deducing what fileset and backend to assume (defun vc-responsible-backend (file &optional register) @@ -1318,24 +1190,6 @@ (or (eq (vc-checkout-model backend (list file)) 'implicit) (memq (vc-state file) '(edited needs-merge conflict)))))) -(defun vc-revert-buffer-internal (&optional arg no-confirm) - "Revert buffer, keeping point and mark where user expects them. -Try to be clever in the face of changes due to expanded version-control -key words. This is important for typeahead to work as expected. -ARG and NO-CONFIRM are passed on to `revert-buffer'." - (interactive "P") - (widen) - (let ((context (vc-buffer-context))) - ;; Use save-excursion here, because it may be able to restore point - ;; and mark properly even in cases where vc-restore-buffer-context - ;; would fail. However, save-excursion might also get it wrong -- - ;; in this case, vc-restore-buffer-context gives it a second try. - (save-excursion - ;; t means don't call normal-mode; - ;; that's to preserve various minor modes. - (revert-buffer arg no-confirm t)) - (vc-restore-buffer-context context))) - (defun vc-buffer-sync (&optional not-urgent) "Make sure the current buffer and its working file are in sync. NOT-URGENT means it is ok to continue if the user says not to save." @@ -1639,46 +1493,6 @@ (let ((vc-handled-backends (list backend))) (call-interactively 'vc-register))) -(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win)) - -(defun vc-resynch-window (file &optional keep noquery) - "If FILE is in the current buffer, either revert or unvisit it. -The choice between revert (to see expanded keywords) and unvisit depends on -`vc-keep-workfiles'. NOQUERY if non-nil inhibits confirmation for -reverting. NOQUERY should be t *only* if it is known the only -difference between the buffer and the file is due to version control -rather than user editing!" - (and (string= buffer-file-name file) - (if keep - (progn - (vc-revert-buffer-internal t noquery) - ;; TODO: Adjusting view mode might no longer be necessary - ;; after RMS change to files.el of 1999-08-08. Investigate - ;; this when we install the new VC. - (and view-read-only - (if (file-writable-p file) - (and view-mode - (let ((view-old-buffer-read-only nil)) - (view-mode-exit))) - (and (not view-mode) - (not (eq (get major-mode 'mode-class) 'special)) - (view-mode-enter)))) - (vc-mode-line buffer-file-name)) - (kill-buffer (current-buffer))))) - -(defun vc-resynch-buffer (file &optional keep noquery) - "If FILE is currently visited, resynch its buffer." - (if (string= buffer-file-name file) - (vc-resynch-window file keep noquery) - (let ((buffer (get-file-buffer file))) - (when buffer - (with-current-buffer buffer - (vc-resynch-window file keep noquery))))) - (vc-directory-resynch-file file) - (when (memq 'vc-dir-mark-buffer-changed after-save-hook) - (let ((buffer (get-file-buffer file))) - (vc-dir-mark-buffer-changed file)))) - (defun vc-checkout (file &optional writable rev) "Retrieve a copy of the revision REV of FILE. If WRITABLE is non-nil, make sure the retrieved file is writable. @@ -1755,7 +1569,9 @@ If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided that the version control system supports this mode of operation. -Runs the normal hook `vc-checkin-hook'." +Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." + (when vc-before-checkin-hook + (run-hooks 'vc-before-checkin-hook)) (vc-start-logentry files rev comment initial-contents "Enter a change comment." @@ -1778,57 +1594,6 @@ (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook)) -(defun vc-finish-logentry (&optional nocomment) - "Complete the operation implied by the current log entry. -Use the contents of the current buffer as a check-in or registration -comment. If the optional arg NOCOMMENT is non-nil, then don't check -the buffer contents as a comment." - (interactive) - ;; Check and record the comment, if any. - (unless nocomment - (run-hooks 'vc-logentry-check-hook)) - ;; Sync parent buffer in case the user modified it while editing the comment. - ;; But not if it is a vc-dired buffer. - (with-current-buffer vc-parent-buffer - (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync))) - (unless vc-log-operation - (error "No log operation is pending")) - ;; save the parameters held in buffer-local variables - (let ((log-operation vc-log-operation) - (log-fileset vc-log-fileset) - (log-revision vc-log-revision) - (log-entry (buffer-string)) - (after-hook vc-log-after-operation-hook) - (tmp-vc-parent-buffer vc-parent-buffer)) - (pop-to-buffer vc-parent-buffer) - ;; OK, do it to it - (save-excursion - (funcall log-operation - log-fileset - log-revision - log-entry)) - ;; Remove checkin window (after the checkin so that if that fails - ;; we don't zap the *VC-log* buffer and the typing therein). - ;; -- IMO this should be replaced with quit-window - (let ((logbuf (get-buffer "*VC-log*"))) - (cond ((and logbuf vc-delete-logbuf-window) - (delete-windows-on logbuf (selected-frame)) - ;; Kill buffer and delete any other dedicated windows/frames. - (kill-buffer logbuf)) - (logbuf (pop-to-buffer "*VC-log*") - (bury-buffer) - (pop-to-buffer tmp-vc-parent-buffer)))) - ;; Now make sure we see the expanded headers - (when log-fileset - (mapc - (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t)) - log-fileset)) - (when vc-dired-mode - (dired-move-to-filename)) - (when (eq major-mode 'vc-dir-mode) - (vc-dir-move-to-goal-column)) - (run-hooks after-hook 'vc-finish-logentry-hook))) - ;;; Additional entry points for examining version histories ;; (defun vc-default-diff-tree (backend dir rev1 rev2)