aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/vc
diff options
context:
space:
mode:
authorStefan Monnier2013-04-20 12:24:04 -0400
committerStefan Monnier2013-04-20 12:24:04 -0400
commitbcd7a0a4c55f8226e9322d1ef438040fed2dc57e (patch)
tree54f28f5694dddc8f391eed169515992bbb46cacb /lisp/vc
parent806bda47ddb469f6206ecc533458eadae6a5b575 (diff)
downloademacs-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.el12
-rw-r--r--lisp/vc/vc-dispatcher.el45
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.
228If the current buffer has no process, just evaluate CODE. 225If the current buffer has no process, just evaluate CODE.
229Else, add CODE to the process' sentinel." 226Else, add CODE to the process' sentinel.
227CODE can be either a function of no arguments, or an expression
228to 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.
523The choice between revert (to see expanded keywords) and unvisit 520The choice between revert (to see expanded keywords) and unvisit