Mercurial > emacs
comparison lisp/vc.el @ 84586:3048d1b37570
(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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sat, 15 Sep 2007 22:25:55 +0000 |
| parents | 1924e5040965 |
| children | 2fe89ebca6d3 |
comparison
equal
deleted
inserted
replaced
| 84585:da12600035f6 | 84586:3048d1b37570 |
|---|---|
| 973 (setq default-directory olddir) | 973 (setq default-directory olddir) |
| 974 (let ((buffer-undo-list t) | 974 (let ((buffer-undo-list t) |
| 975 (inhibit-read-only t)) | 975 (inhibit-read-only t)) |
| 976 (erase-buffer)))) | 976 (erase-buffer)))) |
| 977 | 977 |
| 978 (defvar vc-sentinel-movepoint) ;Dynamically scoped. | |
| 979 | |
| 980 (defun vc-process-sentinel (p s) | |
| 981 (let ((previous (process-get p 'vc-previous-sentinel))) | |
| 982 (if previous (funcall previous p s)) | |
| 983 (with-current-buffer (process-buffer p) | |
| 984 (let (vc-sentinel-movepoint) | |
| 985 ;; Normally, we want async code such as sentinels to not move point. | |
| 986 (save-excursion | |
| 987 (goto-char (process-mark p)) | |
| 988 (let ((cmds (process-get p 'vc-sentinel-commands))) | |
| 989 (process-put p 'vc-postprocess nil) | |
| 990 (dolist (cmd cmds) | |
| 991 ;; Each sentinel may move point and the next one should be run | |
| 992 ;; at that new point. We could get the same result by having | |
| 993 ;; each sentinel read&set process-mark, but since `cmd' needs | |
| 994 ;; to work both for async and sync processes, this would be | |
| 995 ;; difficult to achieve. | |
| 996 (vc-exec-after cmd)))) | |
| 997 ;; But sometimes the sentinels really want to move point. | |
| 998 (if vc-sentinel-movepoint | |
| 999 (let ((win (get-buffer-window (current-buffer) 0))) | |
| 1000 (if (not win) | |
| 1001 (goto-char vc-sentinel-movepoint) | |
| 1002 (with-selected-window win | |
| 1003 (goto-char vc-sentinel-movepoint))))))))) | |
| 1004 | |
| 978 (defun vc-exec-after (code) | 1005 (defun vc-exec-after (code) |
| 979 "Eval CODE when the current buffer's process is done. | 1006 "Eval CODE when the current buffer's process is done. |
| 980 If the current buffer has no process, just evaluate CODE. | 1007 If the current buffer has no process, just evaluate CODE. |
| 981 Else, add CODE to the process' sentinel." | 1008 Else, add CODE to the process' sentinel." |
| 982 (let ((proc (get-buffer-process (current-buffer)))) | 1009 (let ((proc (get-buffer-process (current-buffer)))) |
| 990 ;; Make sure we've read the process's output before going further. | 1017 ;; Make sure we've read the process's output before going further. |
| 991 (if proc (accept-process-output proc)) | 1018 (if proc (accept-process-output proc)) |
| 992 (eval code)) | 1019 (eval code)) |
| 993 ;; If a process is running, add CODE to the sentinel | 1020 ;; If a process is running, add CODE to the sentinel |
| 994 ((eq (process-status proc) 'run) | 1021 ((eq (process-status proc) 'run) |
| 995 (let ((sentinel (process-sentinel proc))) | 1022 (let ((previous (process-sentinel proc))) |
| 996 (set-process-sentinel proc | 1023 (unless (eq previous 'vc-process-sentinel) |
| 997 `(lambda (p s) | 1024 (process-put proc 'vc-previous-sentinel previous)) |
| 998 (with-current-buffer ',(current-buffer) | 1025 (set-process-sentinel proc 'vc-process-sentinel)) |
| 999 (save-excursion | 1026 (process-put proc 'vc-sentinel-commands |
| 1000 (goto-char (process-mark p)) | 1027 (cons code (process-get proc 'vc-sentinel-commands)))) |
| 1001 ,@(append (cdr (cdr (car ;Strip off (save-exc (goto-char...) | |
| 1002 (cdr (cdr ;Strip off (with-current-buffer buf | |
| 1003 (car (cdr (cdr ;Strip off (lambda (p s) | |
| 1004 sentinel)))))))) | |
| 1005 (list `(vc-exec-after ',code))))))))) | |
| 1006 (t (error "Unexpected process state")))) | 1028 (t (error "Unexpected process state")))) |
| 1007 nil) | 1029 nil) |
| 1008 | 1030 |
| 1009 (defvar vc-post-command-functions nil | 1031 (defvar vc-post-command-functions nil |
| 1010 "Hook run at the end of `vc-do-command'. | 1032 "Hook run at the end of `vc-do-command'. |
| 1085 (error "Running %s...FAILED (%s)" full-command | 1107 (error "Running %s...FAILED (%s)" full-command |
| 1086 (if (integerp status) (format "status %d" status) status)))) | 1108 (if (integerp status) (format "status %d" status) status)))) |
| 1087 (if vc-command-messages | 1109 (if vc-command-messages |
| 1088 (message "Running %s...OK" full-command))) | 1110 (message "Running %s...OK" full-command))) |
| 1089 (vc-exec-after | 1111 (vc-exec-after |
| 1090 `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags)) | 1112 `(run-hook-with-args 'vc-post-command-functions |
| 1113 ',command ',file-or-list ',flags)) | |
| 1091 status)))) | 1114 status)))) |
| 1092 | 1115 |
| 1093 (defun vc-position-context (posn) | 1116 (defun vc-position-context (posn) |
| 1094 "Save a bit of the text around POSN in the current buffer. | 1117 "Save a bit of the text around POSN in the current buffer. |
| 1095 Used to help us find the corresponding position again later | 1118 Used to help us find the corresponding position again later |
| 2555 ;; (shrink-window-if-larger-than-buffer) | 2578 ;; (shrink-window-if-larger-than-buffer) |
| 2556 ;; move point to the log entry for the current version | 2579 ;; move point to the log entry for the current version |
| 2557 (vc-call-backend ',(vc-backend file) | 2580 (vc-call-backend ',(vc-backend file) |
| 2558 'show-log-entry | 2581 'show-log-entry |
| 2559 ',focus-rev) | 2582 ',focus-rev) |
| 2583 (setq vc-sentinel-movepoint (point)) | |
| 2560 (set-buffer-modified-p nil))))) | 2584 (set-buffer-modified-p nil))))) |
| 2561 | 2585 |
| 2562 (defun vc-default-log-view-mode (backend) (log-view-mode)) | 2586 (defun vc-default-log-view-mode (backend) (log-view-mode)) |
| 2563 (defun vc-default-show-log-entry (backend rev) | 2587 (defun vc-default-show-log-entry (backend rev) |
| 2564 (with-no-warnings | 2588 (with-no-warnings |
| 3277 `(progn | 3301 `(progn |
| 3278 ;; Ideally, we'd rather not move point if the user has already | 3302 ;; Ideally, we'd rather not move point if the user has already |
| 3279 ;; moved it elsewhere, but really point here is not the position | 3303 ;; moved it elsewhere, but really point here is not the position |
| 3280 ;; of the user's cursor :-( | 3304 ;; of the user's cursor :-( |
| 3281 (when ,current-line ;(and (bobp)) | 3305 (when ,current-line ;(and (bobp)) |
| 3282 (let ((win (get-buffer-window (current-buffer) 0))) | 3306 (goto-line ,current-line) |
| 3283 (when win | 3307 (setq vc-sentinel-movepoint)) |
| 3284 (with-selected-window win | |
| 3285 (goto-line ,current-line))))) | |
| 3286 (unless (active-minibuffer-window) | 3308 (unless (active-minibuffer-window) |
| 3287 (message "Annotating... done"))))))) | 3309 (message "Annotating... done"))))))) |
| 3288 | 3310 |
| 3289 (defun vc-annotate-prev-version (prefix) | 3311 (defun vc-annotate-prev-version (prefix) |
| 3290 "Visit the annotation of the version previous to this one. | 3312 "Visit the annotation of the version previous to this one. |