Commit 86e80023 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(vc-process-sentinel): New function.

(vc-exec-after): Use it instead of using ugly hackish analysis and
construction of Elisp code.
(vc-sentinel-movepoint): New dynamically scoped var.
(vc-print-log, vc-annotate): Set it to move the user's point.
parent 0f71f9da
2007-09-15 Stefan Monnier <monnier@iro.umontreal.ca> 2007-09-15 Stefan Monnier <monnier@iro.umontreal.ca>
* vc.el (vc-process-sentinel): New function.
(vc-exec-after): Use it instead of using ugly hackish analysis and
construction of Elisp code.
(vc-sentinel-movepoint): New dynamically scoped var.
(vc-print-log, vc-annotate): Set it to move the user's point.
* vc-cvs.el (vc-cvs-annotate-time): Use inhibit-read-only and * vc-cvs.el (vc-cvs-annotate-time): Use inhibit-read-only and
inhibit-modification-hooks. inhibit-modification-hooks.
......
...@@ -975,6 +975,33 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary." ...@@ -975,6 +975,33 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary."
(inhibit-read-only t)) (inhibit-read-only t))
(erase-buffer)))) (erase-buffer))))
(defvar vc-sentinel-movepoint) ;Dynamically scoped.
(defun vc-process-sentinel (p s)
(let ((previous (process-get p 'vc-previous-sentinel)))
(if previous (funcall previous p s))
(with-current-buffer (process-buffer p)
(let (vc-sentinel-movepoint)
;; Normally, we want async code such as sentinels to not move point.
(save-excursion
(goto-char (process-mark p))
(let ((cmds (process-get p 'vc-sentinel-commands)))
(process-put p 'vc-postprocess nil)
(dolist (cmd cmds)
;; Each sentinel may move point and the next one should be run
;; at that new point. We could get the same result by having
;; each sentinel read&set process-mark, but since `cmd' needs
;; to work both for async and sync processes, this would be
;; difficult to achieve.
(vc-exec-after cmd))))
;; But sometimes the sentinels really want to move point.
(if vc-sentinel-movepoint
(let ((win (get-buffer-window (current-buffer) 0)))
(if (not win)
(goto-char vc-sentinel-movepoint)
(with-selected-window win
(goto-char vc-sentinel-movepoint)))))))))
(defun vc-exec-after (code) (defun vc-exec-after (code)
"Eval CODE when the current buffer's process is done. "Eval CODE when the current buffer's process is done.
If the current buffer has no process, just evaluate CODE. If the current buffer has no process, just evaluate CODE.
...@@ -992,17 +1019,12 @@ Else, add CODE to the process' sentinel." ...@@ -992,17 +1019,12 @@ Else, add CODE to the process' sentinel."
(eval code)) (eval code))
;; If a process is running, add CODE to the sentinel ;; If a process is running, add CODE to the sentinel
((eq (process-status proc) 'run) ((eq (process-status proc) 'run)
(let ((sentinel (process-sentinel proc))) (let ((previous (process-sentinel proc)))
(set-process-sentinel proc (unless (eq previous 'vc-process-sentinel)
`(lambda (p s) (process-put proc 'vc-previous-sentinel previous))
(with-current-buffer ',(current-buffer) (set-process-sentinel proc 'vc-process-sentinel))
(save-excursion (process-put proc 'vc-sentinel-commands
(goto-char (process-mark p)) (cons code (process-get proc 'vc-sentinel-commands))))
,@(append (cdr (cdr (car ;Strip off (save-exc (goto-char...)
(cdr (cdr ;Strip off (with-current-buffer buf
(car (cdr (cdr ;Strip off (lambda (p s)
sentinel))))))))
(list `(vc-exec-after ',code)))))))))
(t (error "Unexpected process state")))) (t (error "Unexpected process state"))))
nil) nil)
...@@ -1087,7 +1109,8 @@ that is inserted into the command line before the filename." ...@@ -1087,7 +1109,8 @@ that is inserted into the command line before the filename."
(if vc-command-messages (if vc-command-messages
(message "Running %s...OK" full-command))) (message "Running %s...OK" full-command)))
(vc-exec-after (vc-exec-after
`(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags)) `(run-hook-with-args 'vc-post-command-functions
',command ',file-or-list ',flags))
status)))) status))))
(defun vc-position-context (posn) (defun vc-position-context (posn)
...@@ -2557,6 +2580,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." ...@@ -2557,6 +2580,7 @@ If FOCUS-REV is non-nil, leave the point at that revision."
(vc-call-backend ',(vc-backend file) (vc-call-backend ',(vc-backend file)
'show-log-entry 'show-log-entry
',focus-rev) ',focus-rev)
(setq vc-sentinel-movepoint (point))
(set-buffer-modified-p nil))))) (set-buffer-modified-p nil)))))
(defun vc-default-log-view-mode (backend) (log-view-mode)) (defun vc-default-log-view-mode (backend) (log-view-mode))
...@@ -3279,10 +3303,8 @@ colors. `vc-annotate-background' specifies the background color." ...@@ -3279,10 +3303,8 @@ colors. `vc-annotate-background' specifies the background color."
;; moved it elsewhere, but really point here is not the position ;; moved it elsewhere, but really point here is not the position
;; of the user's cursor :-( ;; of the user's cursor :-(
(when ,current-line ;(and (bobp)) (when ,current-line ;(and (bobp))
(let ((win (get-buffer-window (current-buffer) 0))) (goto-line ,current-line)
(when win (setq vc-sentinel-movepoint))
(with-selected-window win
(goto-line ,current-line)))))
(unless (active-minibuffer-window) (unless (active-minibuffer-window)
(message "Annotating... done"))))))) (message "Annotating... done")))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment