diff options
| author | Stefan Monnier | 2013-04-20 12:24:04 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-04-20 12:24:04 -0400 |
| commit | bcd7a0a4c55f8226e9322d1ef438040fed2dc57e (patch) | |
| tree | 54f28f5694dddc8f391eed169515992bbb46cacb /lisp/vc | |
| parent | 806bda47ddb469f6206ecc533458eadae6a5b575 (diff) | |
| download | emacs-bcd7a0a4c55f8226e9322d1ef438040fed2dc57e.tar.gz emacs-bcd7a0a4c55f8226e9322d1ef438040fed2dc57e.zip | |
Use add/remove-function to manipulate process-filters.
* lisp/emacs-lisp/nadvice.el (advice--where-alist): Add :override.
(remove-function): Autoload.
* lisp/comint.el (comint-redirect-original-filter-function): Remove.
(comint-redirect-cleanup, comint-redirect-send-command-to-process):
* lisp/vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command):
* lisp/progmodes/octave-inf.el (inferior-octave-send-list-and-digest):
* lisp/progmodes/prolog.el (prolog-consult-compile):
* lisp/progmodes/gdb-mi.el (gdb, gdb--check-interpreter):
Use add/remove-function instead.
* lisp/progmodes/gud.el (gud-tooltip-original-filter): Remove.
(gud-tooltip-process-output, gud-tooltip-tips):
Use add/remove-function instead.
* lisp/progmodes/xscheme.el (xscheme-previous-process-state): Remove.
(scheme-interaction-mode, exit-scheme-interaction-mode):
Use add/remove-function instead.
* lisp/vc/vc-dispatcher.el: Use lexical-binding.
(vc--process-sentinel): Rename from vc-process-sentinel.
Change last arg to be the code to run. Don't use vc-previous-sentinel
and vc-sentinel-commands any more.
(vc-exec-after): Allow code to be a function. Use add/remove-function.
(compilation-error-regexp-alist, view-old-buffer-read-only): Declare.
Diffstat (limited to 'lisp/vc')
| -rw-r--r-- | lisp/vc/vc-cvs.el | 12 | ||||
| -rw-r--r-- | lisp/vc/vc-dispatcher.el | 45 |
2 files changed, 26 insertions, 31 deletions
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 407e691439b..334683898be 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el | |||
| @@ -562,14 +562,13 @@ Will fail unless you have administrative privileges on the repo." | |||
| 562 | 562 | ||
| 563 | (defconst vc-cvs-annotate-first-line-re "^[0-9]") | 563 | (defconst vc-cvs-annotate-first-line-re "^[0-9]") |
| 564 | 564 | ||
| 565 | (defun vc-cvs-annotate-process-filter (process string) | 565 | (defun vc-cvs-annotate-process-filter (filter process string) |
| 566 | (setq string (concat (process-get process 'output) string)) | 566 | (setq string (concat (process-get process 'output) string)) |
| 567 | (if (not (string-match vc-cvs-annotate-first-line-re string)) | 567 | (if (not (string-match vc-cvs-annotate-first-line-re string)) |
| 568 | ;; Still waiting for the first real line. | 568 | ;; Still waiting for the first real line. |
| 569 | (process-put process 'output string) | 569 | (process-put process 'output string) |
| 570 | (let ((vc-filter (process-get process 'vc-filter))) | 570 | (remove-function (process-filter process) #'vc-cvs-annotate-process-filter) |
| 571 | (set-process-filter process vc-filter) | 571 | (funcall filter process (substring string (match-beginning 0))))) |
| 572 | (funcall vc-filter process (substring string (match-beginning 0)))))) | ||
| 573 | 572 | ||
| 574 | (defun vc-cvs-annotate-command (file buffer &optional revision) | 573 | (defun vc-cvs-annotate-command (file buffer &optional revision) |
| 575 | "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. | 574 | "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. |
| @@ -583,9 +582,8 @@ Optional arg REVISION is a revision to annotate from." | |||
| 583 | (let ((proc (get-buffer-process buffer))) | 582 | (let ((proc (get-buffer-process buffer))) |
| 584 | (if proc | 583 | (if proc |
| 585 | ;; If running asynchronously, use a process filter. | 584 | ;; If running asynchronously, use a process filter. |
| 586 | (progn | 585 | (add-function :around (process-filter proc) |
| 587 | (process-put proc 'vc-filter (process-filter proc)) | 586 | #'vc-cvs-annotate-process-filter) |
| 588 | (set-process-filter proc 'vc-cvs-annotate-process-filter)) | ||
| 589 | (with-current-buffer buffer | 587 | (with-current-buffer buffer |
| 590 | (goto-char (point-min)) | 588 | (goto-char (point-min)) |
| 591 | (re-search-forward vc-cvs-annotate-first-line-re) | 589 | (re-search-forward vc-cvs-annotate-first-line-re) |
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index ed61adec1fe..309cf50404c 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; vc-dispatcher.el -- generic command-dispatcher facility. | 1 | ;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2008-2013 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2008-2013 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -182,32 +182,29 @@ Another is that undo information is not kept." | |||
| 182 | 182 | ||
| 183 | (defvar vc-sentinel-movepoint) ;Dynamically scoped. | 183 | (defvar vc-sentinel-movepoint) ;Dynamically scoped. |
| 184 | 184 | ||
| 185 | (defun vc-process-sentinel (p s) | 185 | (defun vc--process-sentinel (p code) |
| 186 | (let ((previous (process-get p 'vc-previous-sentinel)) | 186 | (let ((buf (process-buffer p))) |
| 187 | (buf (process-buffer p))) | ||
| 188 | ;; Impatient users sometime kill "slow" buffers; check liveness | 187 | ;; Impatient users sometime kill "slow" buffers; check liveness |
| 189 | ;; to avoid "error in process sentinel: Selecting deleted buffer". | 188 | ;; to avoid "error in process sentinel: Selecting deleted buffer". |
| 190 | (when (buffer-live-p buf) | 189 | (when (buffer-live-p buf) |
| 191 | (when previous (funcall previous p s)) | ||
| 192 | (with-current-buffer buf | 190 | (with-current-buffer buf |
| 193 | (setq mode-line-process | 191 | (setq mode-line-process |
| 194 | (let ((status (process-status p))) | 192 | (let ((status (process-status p))) |
| 195 | ;; Leave mode-line uncluttered, normally. | 193 | ;; Leave mode-line uncluttered, normally. |
| 196 | (unless (eq 'exit status) | 194 | (unless (eq 'exit status) |
| 197 | (format " (%s)" status)))) | 195 | (format " (%s)" status)))) |
| 198 | (let (vc-sentinel-movepoint) | 196 | (let (vc-sentinel-movepoint |
| 197 | (m (process-mark p))) | ||
| 199 | ;; Normally, we want async code such as sentinels to not move point. | 198 | ;; Normally, we want async code such as sentinels to not move point. |
| 200 | (save-excursion | 199 | (save-excursion |
| 201 | (goto-char (process-mark p)) | 200 | (goto-char m) |
| 202 | (let ((cmds (process-get p 'vc-sentinel-commands))) | ||
| 203 | (process-put p 'vc-sentinel-commands nil) | ||
| 204 | (dolist (cmd cmds) | ||
| 205 | ;; Each sentinel may move point and the next one should be run | 201 | ;; Each sentinel may move point and the next one should be run |
| 206 | ;; at that new point. We could get the same result by having | 202 | ;; at that new point. We could get the same result by having |
| 207 | ;; each sentinel read&set process-mark, but since `cmd' needs | 203 | ;; each sentinel read&set process-mark, but since `cmd' needs |
| 208 | ;; to work both for async and sync processes, this would be | 204 | ;; to work both for async and sync processes, this would be |
| 209 | ;; difficult to achieve. | 205 | ;; difficult to achieve. |
| 210 | (vc-exec-after cmd)))) | 206 | (vc-exec-after code) |
| 207 | (move-marker m (point))) | ||
| 211 | ;; But sometimes the sentinels really want to move point. | 208 | ;; But sometimes the sentinels really want to move point. |
| 212 | (when vc-sentinel-movepoint | 209 | (when vc-sentinel-movepoint |
| 213 | (let ((win (get-buffer-window (current-buffer) 0))) | 210 | (let ((win (get-buffer-window (current-buffer) 0))) |
| @@ -226,7 +223,9 @@ Another is that undo information is not kept." | |||
| 226 | (defun vc-exec-after (code) | 223 | (defun vc-exec-after (code) |
| 227 | "Eval CODE when the current buffer's process is done. | 224 | "Eval CODE when the current buffer's process is done. |
| 228 | If the current buffer has no process, just evaluate CODE. | 225 | If the current buffer has no process, just evaluate CODE. |
| 229 | Else, add CODE to the process' sentinel." | 226 | Else, add CODE to the process' sentinel. |
| 227 | CODE can be either a function of no arguments, or an expression | ||
| 228 | to evaluate." | ||
| 230 | (let ((proc (get-buffer-process (current-buffer)))) | 229 | (let ((proc (get-buffer-process (current-buffer)))) |
| 231 | (cond | 230 | (cond |
| 232 | ;; If there's no background process, just execute the code. | 231 | ;; If there's no background process, just execute the code. |
| @@ -237,20 +236,14 @@ Else, add CODE to the process' sentinel." | |||
| 237 | ((or (null proc) (eq (process-status proc) 'exit)) | 236 | ((or (null proc) (eq (process-status proc) 'exit)) |
| 238 | ;; Make sure we've read the process's output before going further. | 237 | ;; Make sure we've read the process's output before going further. |
| 239 | (when proc (accept-process-output proc)) | 238 | (when proc (accept-process-output proc)) |
| 240 | (eval code)) | 239 | (if (functionp code) (funcall code) (eval code))) |
| 241 | ;; If a process is running, add CODE to the sentinel | 240 | ;; If a process is running, add CODE to the sentinel |
| 242 | ((eq (process-status proc) 'run) | 241 | ((eq (process-status proc) 'run) |
| 243 | (vc-set-mode-line-busy-indicator) | 242 | (vc-set-mode-line-busy-indicator) |
| 244 | (let ((previous (process-sentinel proc))) | 243 | (letrec ((fun (lambda (p _msg) |
| 245 | (unless (eq previous 'vc-process-sentinel) | 244 | (remove-function (process-sentinel p) fun) |
| 246 | (process-put proc 'vc-previous-sentinel previous)) | 245 | (vc--process-sentinel p code)))) |
| 247 | (set-process-sentinel proc 'vc-process-sentinel)) | 246 | (add-function :after (process-sentinel proc) fun))) |
| 248 | (process-put proc 'vc-sentinel-commands | ||
| 249 | ;; We keep the code fragments in the order given | ||
| 250 | ;; so that vc-diff-finish's message shows up in | ||
| 251 | ;; the presence of non-nil vc-command-messages. | ||
| 252 | (append (process-get proc 'vc-sentinel-commands) | ||
| 253 | (list code)))) | ||
| 254 | (t (error "Unexpected process state")))) | 247 | (t (error "Unexpected process state")))) |
| 255 | nil) | 248 | nil) |
| 256 | 249 | ||
| @@ -388,6 +381,8 @@ Display the buffer in some window, but don't select it." | |||
| 388 | (set-window-start window new-window-start)) | 381 | (set-window-start window new-window-start)) |
| 389 | buffer)) | 382 | buffer)) |
| 390 | 383 | ||
| 384 | (defvar compilation-error-regexp-alist) | ||
| 385 | |||
| 391 | (defun vc-compilation-mode (backend) | 386 | (defun vc-compilation-mode (backend) |
| 392 | "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." | 387 | "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." |
| 393 | (let* ((error-regexp-alist | 388 | (let* ((error-regexp-alist |
| @@ -479,7 +474,7 @@ Used by `vc-restore-buffer-context' to later restore the context." | |||
| 479 | (vc-position-context (mark-marker)))) | 474 | (vc-position-context (mark-marker)))) |
| 480 | ;; Make the right thing happen in transient-mark-mode. | 475 | ;; Make the right thing happen in transient-mark-mode. |
| 481 | (mark-active nil)) | 476 | (mark-active nil)) |
| 482 | (list point-context mark-context nil))) | 477 | (list point-context mark-context))) |
| 483 | 478 | ||
| 484 | (defun vc-restore-buffer-context (context) | 479 | (defun vc-restore-buffer-context (context) |
| 485 | "Restore point/mark, and reparse any affected compilation buffers. | 480 | "Restore point/mark, and reparse any affected compilation buffers. |
| @@ -518,6 +513,8 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'." | |||
| 518 | (make-variable-buffer-local 'vc-mode-line-hook) | 513 | (make-variable-buffer-local 'vc-mode-line-hook) |
| 519 | (put 'vc-mode-line-hook 'permanent-local t) | 514 | (put 'vc-mode-line-hook 'permanent-local t) |
| 520 | 515 | ||
| 516 | (defvar view-old-buffer-read-only) | ||
| 517 | |||
| 521 | (defun vc-resynch-window (file &optional keep noquery reset-vc-info) | 518 | (defun vc-resynch-window (file &optional keep noquery reset-vc-info) |
| 522 | "If FILE is in the current buffer, either revert or unvisit it. | 519 | "If FILE is in the current buffer, either revert or unvisit it. |
| 523 | The choice between revert (to see expanded keywords) and unvisit | 520 | The choice between revert (to see expanded keywords) and unvisit |