mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00
Code Issues Projects Releases Wiki Activity

Use add/remove-function to manipulate process-filters.

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2013-04-20 12:24:04 -04:00
parent 806bda47dd
commit bcd7a0a4c5
10 changed files with 101 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

30
lisp/ChangeLog
View file

@ -1,7 +1,33 @@
2013-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/nadvice.el (advice--where-alist): Add :override.
(remove-function): Autoload.
* comint.el (comint-redirect-original-filter-function): Remove.
(comint-redirect-cleanup, comint-redirect-send-command-to-process):
* vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command):
* progmodes/octave-inf.el (inferior-octave-send-list-and-digest):
* progmodes/prolog.el (prolog-consult-compile):
* progmodes/gdb-mi.el (gdb, gdb--check-interpreter):
Use add/remove-function instead.
* progmodes/gud.el (gud-tooltip-original-filter): Remove.
(gud-tooltip-process-output, gud-tooltip-tips):
Use add/remove-function instead.
* progmodes/xscheme.el (xscheme-previous-process-state): Remove.
(scheme-interaction-mode, exit-scheme-interaction-mode):
Use add/remove-function instead.
* 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.
2013-04-19 Masatake YAMATO <yamato@redhat.com> 2013-04-19 Masatake YAMATO <yamato@redhat.com>
* progmodes/sh-script.el (sh-imenu-generic-expression): Handle * progmodes/sh-script.el (sh-imenu-generic-expression):
function names with a single character. (Bug#11182) Handle function names with a single character. (Bug#11182)
2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change) 2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change)

15
lisp/comint.el
View file

@ -3491,11 +3491,6 @@ buffer. The idea is that this regular expression should match a prompt
string, and that there ought to be at least one copy of your prompt string string, and that there ought to be at least one copy of your prompt string
in the process buffer already.") in the process buffer already.")
(defvar comint-redirect-original-filter-function nil
"The process filter that was in place when redirection is started.
When redirection is completed, the process filter is restored to
this value.")
(defvar comint-redirect-subvert-readonly nil (defvar comint-redirect-subvert-readonly nil
"Non-nil means `comint-redirect' can insert into read-only buffers. "Non-nil means `comint-redirect' can insert into read-only buffers.
This works by binding `inhibit-read-only' around the insertion. This works by binding `inhibit-read-only' around the insertion.
@ -3558,8 +3553,8 @@ and does not normally need to be invoked by the end user or programmer."
;; Release the last redirected string ;; Release the last redirected string
(setq comint-redirect-previous-input-string nil) (setq comint-redirect-previous-input-string nil)
;; Restore the process filter ;; Restore the process filter
(set-process-filter (get-buffer-process (current-buffer)) (remove-function (process-filter (get-buffer-process (current-buffer)))
comint-redirect-original-filter-function) #'comint-redirect-filter)
;; Restore the mode line ;; Restore the mode line
(setq mode-line-process comint-redirect-original-mode-line-process) (setq mode-line-process comint-redirect-original-mode-line-process)
;; Set the completed flag ;; Set the completed flag
@ -3701,10 +3696,8 @@ If NO-DISPLAY is non-nil, do not show the output buffer."
comint-prompt-regexp ; Finished Regexp comint-prompt-regexp ; Finished Regexp
echo) ; Echo input echo) ; Echo input
;; Set the filter ;; Set the filter.
(setq comint-redirect-original-filter-function ; Save the old filter (add-function :override (process-filter proc) #'comint-redirect-filter)
(process-filter proc))
(set-process-filter proc 'comint-redirect-filter)
;; Send the command ;; Send the command
(process-send-string (current-buffer) (concat command "\n")) (process-send-string (current-buffer) (concat command "\n"))

3
lisp/emacs-lisp/nadvice.el
View file

@ -41,6 +41,7 @@
'((:around "\300\301\302\003#\207" 5) '((:around "\300\301\302\003#\207" 5)
(:before "\300\301\002\"\210\300\302\002\"\207" 4) (:before "\300\301\002\"\210\300\302\002\"\207" 4)
(:after "\300\302\002\"\300\301\003\"\210\207" 5) (:after "\300\302\002\"\300\301\003\"\210\207" 5)
(:override "\300\301\"\207" 4)
(:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4) (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
(:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4) (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
(:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4) (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
@ -228,6 +229,7 @@ call OLDFUN here:
`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) `:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) `:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) `:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
`:override' (lambda (&rest r) (apply FUNCTION r))
`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) `:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) `:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) `:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
@ -263,6 +265,7 @@ is also interactive. There are 3 cases:
(setf (gv-deref ref) (setf (gv-deref ref)
(advice--make where function (gv-deref ref) props)))) (advice--make where function (gv-deref ref) props))))
;;;###autoload
(defmacro remove-function (place function) (defmacro remove-function (place function)
"Remove the FUNCTION piece of advice from PLACE. "Remove the FUNCTION piece of advice from PLACE.
If FUNCTION was not added to PLACE, do nothing. If FUNCTION was not added to PLACE, do nothing.

30
lisp/progmodes/gdb-mi.el
View file

@ -574,21 +574,20 @@ NOARG must be t when this macro is used outside `gud-def'"
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2) (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg))) ,(when (not noarg) 'arg)))
(defun gdb--check-interpreter (proc string) (defun gdb--check-interpreter (filter proc string)
(unless (zerop (length string)) (unless (zerop (length string))
(let ((filter (process-get proc 'gud-normal-filter))) (remove-function (process-filter proc) #'gdb--check-interpreter)
(set-process-filter proc filter) (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
(unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) ;; Apparently we're not running with -i=mi.
;; Apparently we're not running with -i=mi. (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
(let ((msg "Error: you did not specify -i=mi on GDB's command line!")) (message msg)
(message msg) (setq string (concat (propertize msg 'font-lock-face 'error)
(setq string (concat (propertize msg 'font-lock-face 'error) "\n" string)))
"\n" string))) ;; Use the old gud-gbd filter, not because it works, but because it
;; Use the old gud-gbd filter, not because it works, but because it ;; will properly display GDB's answers rather than hanging waiting for
;; will properly display GDB's answers rather than hanging waiting for ;; answers that aren't coming.
;; answers that aren't coming. (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
(set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter)) (funcall filter proc string)))
(funcall filter proc string))))
(defvar gdb-control-level 0) (defvar gdb-control-level 0)
@ -662,8 +661,7 @@ detailed description of this mode.
;; Setup a temporary process filter to warn when GDB was not started ;; Setup a temporary process filter to warn when GDB was not started
;; with -i=mi. ;; with -i=mi.
(let ((proc (get-buffer-process gud-comint-buffer))) (let ((proc (get-buffer-process gud-comint-buffer)))
(process-put proc 'gud-normal-filter (process-filter proc)) (add-function :around (process-filter proc) #'gdb--check-interpreter))
(set-process-filter proc #'gdb--check-interpreter))
(set (make-local-variable 'gud-minor-mode) 'gdbmi) (set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gdb-control-level) 0) (set (make-local-variable 'gdb-control-level) 0)

9
lisp/progmodes/gud.el
View file

@ -3387,9 +3387,6 @@ ACTIVATEP non-nil means activate mouse motion events."
;;; Tips for `gud' ;;; Tips for `gud'
(defvar gud-tooltip-original-filter nil
"Process filter to restore after GUD output has been received.")
(defvar gud-tooltip-dereference nil (defvar gud-tooltip-dereference nil
"Non-nil means print expressions with a `*' in front of them. "Non-nil means print expressions with a `*' in front of them.
For C this would dereference a pointer expression.") For C this would dereference a pointer expression.")
@ -3423,7 +3420,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
; gdb-mi.el gets round this problem. ; gdb-mi.el gets round this problem.
(defun gud-tooltip-process-output (process output) (defun gud-tooltip-process-output (process output)
"Process debugger output and show it in a tooltip window." "Process debugger output and show it in a tooltip window."
(set-process-filter process gud-tooltip-original-filter) (remove-function (process-filter process) #'gud-tooltip-process-output)
(tooltip-show (tooltip-strip-prompt process output) (tooltip-show (tooltip-strip-prompt process output)
(or gud-tooltip-echo-area tooltip-use-echo-area))) (or gud-tooltip-echo-area tooltip-use-echo-area)))
@ -3490,8 +3487,8 @@ so they have been disabled."))
(gdb-input (gdb-input
(concat cmd "\n") (concat cmd "\n")
`(lambda () (gdb-tooltip-print ,expr)))) `(lambda () (gdb-tooltip-print ,expr))))
(setq gud-tooltip-original-filter (process-filter process)) (add-function :override (process-filter process)
(set-process-filter process 'gud-tooltip-process-output) #'gud-tooltip-process-output)
(gud-basic-call cmd)) (gud-basic-call cmd))
expr)))))))) expr))))))))

7
lisp/progmodes/octave-inf.el
View file

@ -348,9 +348,9 @@ the rest to `inferior-octave-output-string'."
The elements of LIST have to be strings and are sent one by one. All The elements of LIST have to be strings and are sent one by one. All
output is passed to the filter `inferior-octave-output-digest'." output is passed to the filter `inferior-octave-output-digest'."
(let* ((proc inferior-octave-process) (let* ((proc inferior-octave-process)
(filter (process-filter proc))
string) string)
(set-process-filter proc 'inferior-octave-output-digest) (add-function :override (process-filter proc)
#'inferior-octave-output-digest)
(setq inferior-octave-output-list nil) (setq inferior-octave-output-list nil)
(unwind-protect (unwind-protect
(while (setq string (car list)) (while (setq string (car list))
@ -360,7 +360,8 @@ output is passed to the filter `inferior-octave-output-digest'."
(while inferior-octave-receive-in-progress (while inferior-octave-receive-in-progress
(accept-process-output proc)) (accept-process-output proc))
(setq list (cdr list))) (setq list (cdr list)))
(set-process-filter proc filter)))) (remove-function (process-filter proc)
#'inferior-octave-output-digest))))
(defun inferior-octave-directory-tracker (string) (defun inferior-octave-directory-tracker (string)
"Tracks `cd' commands issued to the inferior Octave process. "Tracks `cd' commands issued to the inferior Octave process.

6
lisp/progmodes/prolog.el
View file

@ -1770,7 +1770,8 @@ This function must be called from the source code buffer."
real-file)) real-file))
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-max)) (goto-char (point-max))
(set-process-filter process 'prolog-consult-compile-filter) (add-function :override (process-filter process)
#'prolog-consult-compile-filter)
(process-send-string "prolog" command-string) (process-send-string "prolog" command-string)
;; (prolog-build-prolog-command compilep file real-file first-line)) ;; (prolog-build-prolog-command compilep file real-file first-line))
(while (and prolog-process-flag (while (and prolog-process-flag
@ -1781,7 +1782,8 @@ This function must be called from the source code buffer."
(insert (if compilep (insert (if compilep
"\nCompilation finished.\n" "\nCompilation finished.\n"
"\nConsulted.\n")) "\nConsulted.\n"))
(set-process-filter process old-filter)))) (remove-function (process-filter process)
#'prolog-consult-compile-filter))))
(defvar compilation-error-list) (defvar compilation-error-list)

39
lisp/progmodes/xscheme.el
View file

@ -35,7 +35,6 @@
;;;; Internal Variables ;;;; Internal Variables
(defvar xscheme-previous-mode) (defvar xscheme-previous-mode)
(defvar xscheme-previous-process-state)
(defvar xscheme-last-input-end) (defvar xscheme-last-input-end)
(defvar xscheme-process-command-line nil (defvar xscheme-process-command-line nil
@ -388,8 +387,6 @@ with no args, if that value is non-nil.
(if (not preserve) (if (not preserve)
(let ((previous-mode major-mode)) (let ((previous-mode major-mode))
(kill-all-local-variables) (kill-all-local-variables)
(make-local-variable 'xscheme-process-name)
(make-local-variable 'xscheme-previous-process-state)
(make-local-variable 'xscheme-runlight-string) (make-local-variable 'xscheme-runlight-string)
(make-local-variable 'xscheme-runlight) (make-local-variable 'xscheme-runlight)
(set (make-local-variable 'xscheme-previous-mode) previous-mode) (set (make-local-variable 'xscheme-previous-mode) previous-mode)
@ -397,35 +394,29 @@ with no args, if that value is non-nil.
(set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer))
(set (make-local-variable 'xscheme-last-input-end) (make-marker)) (set (make-local-variable 'xscheme-last-input-end) (make-marker))
(let ((process (get-buffer-process buffer))) (let ((process (get-buffer-process buffer)))
(if process (when process
(progn (setq-local xscheme-process-name (process-name process))
(setq xscheme-process-name (process-name process)) ;; FIXME: Use add-function!
(setq xscheme-previous-process-state (xscheme-process-filter-initialize t)
(cons (process-filter process) (xscheme-mode-line-initialize xscheme-buffer-name)
(process-sentinel process))) (add-function :override (process-sentinel process)
(xscheme-process-filter-initialize t) #'xscheme-process-sentinel)
(xscheme-mode-line-initialize xscheme-buffer-name) (add-function :override (process-filter process)
(set-process-sentinel process 'xscheme-process-sentinel) #'xscheme-process-filter))))))
(set-process-filter process 'xscheme-process-filter))
(setq xscheme-previous-process-state (cons nil nil)))))))
(scheme-interaction-mode-initialize) (scheme-interaction-mode-initialize)
(scheme-mode-variables) (scheme-mode-variables)
(run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
(defun exit-scheme-interaction-mode () (defun exit-scheme-interaction-mode ()
"Take buffer out of scheme interaction mode" "Take buffer out of scheme interaction mode."
(interactive) (interactive)
(if (not (derived-mode-p 'scheme-interaction-mode)) (if (not (derived-mode-p 'scheme-interaction-mode))
(error "Buffer not in scheme interaction mode")) (error "Buffer not in scheme interaction mode"))
(let ((previous-state xscheme-previous-process-state)) (funcall xscheme-previous-mode)
(funcall xscheme-previous-mode) (let ((process (get-buffer-process (current-buffer))))
(let ((process (get-buffer-process (current-buffer)))) (when process
(if process (remove-function (process-sentinel process) #'xscheme-process-sentinel)
(progn (remove-function (process-filter process) #'xscheme-process-filter))))
(if (eq (process-filter process) 'xscheme-process-filter)
(set-process-filter process (car previous-state)))
(if (eq (process-sentinel process) 'xscheme-process-sentinel)
(set-process-sentinel process (cdr previous-state))))))))
(defvar scheme-interaction-mode-commands-alist nil) (defvar scheme-interaction-mode-commands-alist nil)
(defvar scheme-interaction-mode-map nil) (defvar scheme-interaction-mode-map nil)

12
lisp/vc/vc-cvs.el
View file

@ -562,14 +562,13 @@ Will fail unless you have administrative privileges on the repo."
(defconst vc-cvs-annotate-first-line-re "^[0-9]") (defconst vc-cvs-annotate-first-line-re "^[0-9]")
(defun vc-cvs-annotate-process-filter (process string) (defun vc-cvs-annotate-process-filter (filter process string)
(setq string (concat (process-get process 'output) string)) (setq string (concat (process-get process 'output) string))
(if (not (string-match vc-cvs-annotate-first-line-re string)) (if (not (string-match vc-cvs-annotate-first-line-re string))
;; Still waiting for the first real line. ;; Still waiting for the first real line.
(process-put process 'output string) (process-put process 'output string)
(let ((vc-filter (process-get process 'vc-filter))) (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
(set-process-filter process vc-filter) (funcall filter process (substring string (match-beginning 0)))))
(funcall vc-filter process (substring string (match-beginning 0))))))
(defun vc-cvs-annotate-command (file buffer &optional revision) (defun vc-cvs-annotate-command (file buffer &optional revision)
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
@ -583,9 +582,8 @@ Optional arg REVISION is a revision to annotate from."
(let ((proc (get-buffer-process buffer))) (let ((proc (get-buffer-process buffer)))
(if proc (if proc
;; If running asynchronously, use a process filter. ;; If running asynchronously, use a process filter.
(progn (add-function :around (process-filter proc)
(process-put proc 'vc-filter (process-filter proc)) #'vc-cvs-annotate-process-filter)
(set-process-filter proc 'vc-cvs-annotate-process-filter))
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward vc-cvs-annotate-first-line-re) (re-search-forward vc-cvs-annotate-first-line-re)

45
lisp/vc/vc-dispatcher.el
View file

@ -1,4 +1,4 @@
;;; vc-dispatcher.el -- generic command-dispatcher facility. ;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*-
;; Copyright (C) 2008-2013 Free Software Foundation, Inc. ;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
@ -182,32 +182,29 @@ Another is that undo information is not kept."
(defvar vc-sentinel-movepoint) ;Dynamically scoped. (defvar vc-sentinel-movepoint) ;Dynamically scoped.
(defun vc-process-sentinel (p s) (defun vc--process-sentinel (p code)
(let ((previous (process-get p 'vc-previous-sentinel)) (let ((buf (process-buffer p)))
(buf (process-buffer p)))
;; Impatient users sometime kill "slow" buffers; check liveness ;; Impatient users sometime kill "slow" buffers; check liveness
;; to avoid "error in process sentinel: Selecting deleted buffer". ;; to avoid "error in process sentinel: Selecting deleted buffer".
(when (buffer-live-p buf) (when (buffer-live-p buf)
(when previous (funcall previous p s))
(with-current-buffer buf (with-current-buffer buf
(setq mode-line-process (setq mode-line-process
(let ((status (process-status p))) (let ((status (process-status p)))
;; Leave mode-line uncluttered, normally. ;; Leave mode-line uncluttered, normally.
(unless (eq 'exit status) (unless (eq 'exit status)
(format " (%s)" status)))) (format " (%s)" status))))
(let (vc-sentinel-movepoint) (let (vc-sentinel-movepoint
(m (process-mark p)))
;; Normally, we want async code such as sentinels to not move point. ;; Normally, we want async code such as sentinels to not move point.
(save-excursion (save-excursion
(goto-char (process-mark p)) (goto-char m)
(let ((cmds (process-get p 'vc-sentinel-commands)))
(process-put p 'vc-sentinel-commands nil)
(dolist (cmd cmds)
;; Each sentinel may move point and the next one should be run ;; Each sentinel may move point and the next one should be run
;; at that new point. We could get the same result by having ;; at that new point. We could get the same result by having
;; each sentinel read&set process-mark, but since `cmd' needs ;; each sentinel read&set process-mark, but since `cmd' needs
;; to work both for async and sync processes, this would be ;; to work both for async and sync processes, this would be
;; difficult to achieve. ;; difficult to achieve.
(vc-exec-after cmd)))) (vc-exec-after code)
(move-marker m (point)))
;; But sometimes the sentinels really want to move point. ;; But sometimes the sentinels really want to move point.
(when vc-sentinel-movepoint (when vc-sentinel-movepoint
(let ((win (get-buffer-window (current-buffer) 0))) (let ((win (get-buffer-window (current-buffer) 0)))
@ -226,7 +223,9 @@ Another is that undo information is not kept."
(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.
Else, add CODE to the process' sentinel." Else, add CODE to the process' sentinel.
CODE can be either a function of no arguments, or an expression
to evaluate."
(let ((proc (get-buffer-process (current-buffer)))) (let ((proc (get-buffer-process (current-buffer))))
(cond (cond
;; If there's no background process, just execute the code. ;; If there's no background process, just execute the code.
@ -237,20 +236,14 @@ Else, add CODE to the process' sentinel."
((or (null proc) (eq (process-status proc) 'exit)) ((or (null proc) (eq (process-status proc) 'exit))
;; Make sure we've read the process's output before going further. ;; Make sure we've read the process's output before going further.
(when proc (accept-process-output proc)) (when proc (accept-process-output proc))
(eval code)) (if (functionp code) (funcall 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)
(vc-set-mode-line-busy-indicator) (vc-set-mode-line-busy-indicator)
(let ((previous (process-sentinel proc))) (letrec ((fun (lambda (p _msg)
(unless (eq previous 'vc-process-sentinel) (remove-function (process-sentinel p) fun)
(process-put proc 'vc-previous-sentinel previous)) (vc--process-sentinel p code))))
(set-process-sentinel proc 'vc-process-sentinel)) (add-function :after (process-sentinel proc) fun)))
(process-put proc 'vc-sentinel-commands
;; We keep the code fragments in the order given
;; so that vc-diff-finish's message shows up in
;; the presence of non-nil vc-command-messages.
(append (process-get proc 'vc-sentinel-commands)
(list code))))
(t (error "Unexpected process state")))) (t (error "Unexpected process state"))))
nil) nil)
@ -388,6 +381,8 @@ Display the buffer in some window, but don't select it."
(set-window-start window new-window-start)) (set-window-start window new-window-start))
buffer)) buffer))
(defvar compilation-error-regexp-alist)
(defun vc-compilation-mode (backend) (defun vc-compilation-mode (backend)
"Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'."
(let* ((error-regexp-alist (let* ((error-regexp-alist
@ -479,7 +474,7 @@ Used by `vc-restore-buffer-context' to later restore the context."
(vc-position-context (mark-marker)))) (vc-position-context (mark-marker))))
;; Make the right thing happen in transient-mark-mode. ;; Make the right thing happen in transient-mark-mode.
(mark-active nil)) (mark-active nil))
(list point-context mark-context nil))) (list point-context mark-context)))
(defun vc-restore-buffer-context (context) (defun vc-restore-buffer-context (context)
"Restore point/mark, and reparse any affected compilation buffers. "Restore point/mark, and reparse any affected compilation buffers.
@ -518,6 +513,8 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'."
(make-variable-buffer-local 'vc-mode-line-hook) (make-variable-buffer-local 'vc-mode-line-hook)
(put 'vc-mode-line-hook 'permanent-local t) (put 'vc-mode-line-hook 'permanent-local t)
(defvar view-old-buffer-read-only)
(defun vc-resynch-window (file &optional keep noquery reset-vc-info) (defun vc-resynch-window (file &optional keep noquery reset-vc-info)
"If FILE is in the current buffer, either revert or unvisit it. "If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit The choice between revert (to see expanded keywords) and unvisit