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.

10 files changed, 101 insertions, 95 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9bb155b74da..8758eb33e77 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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>
 
-        * progmodes/sh-script.el (sh-imenu-generic-expression): Handle
-        function names with a single character.   (Bug#11182)
+        * progmodes/sh-script.el (sh-imenu-generic-expression):
+        Handle function names with a single character.   (Bug#11182)
 
 2013-04-19  Dima Kogan  <dima@secretsauce.net>    (tiny change)
 
diff --git a/lisp/comint.el b/lisp/comint.el
index 93db4e24f2a..13a38e6e16e 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -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
 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
   "Non-nil means `comint-redirect' can insert into read-only buffers.
 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
   (setq comint-redirect-previous-input-string nil)
   ;; Restore the process filter
-  (set-process-filter (get-buffer-process (current-buffer))
-                      comint-redirect-original-filter-function)
+  (remove-function (process-filter (get-buffer-process (current-buffer)))
+                   #'comint-redirect-filter)
   ;; Restore the mode line
   (setq mode-line-process comint-redirect-original-mode-line-process)
   ;; 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
        echo)                            ; Echo input
 
-      ;; Set the filter
-      (setq comint-redirect-original-filter-function ; Save the old filter
-            (process-filter proc))
-      (set-process-filter proc 'comint-redirect-filter)
+      ;; Set the filter.
+      (add-function :override (process-filter proc) #'comint-redirect-filter)
 
       ;; Send the command
       (process-send-string (current-buffer) (concat command "\n"))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index a3dfb0326e6..12166553a14 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -41,6 +41,7 @@
   '((:around "\300\301\302\003#\207" 5)
     (:before "\300\301\002\"\210\300\302\002\"\207" 4)
     (: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-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)
@@ -228,6 +229,7 @@ call OLDFUN here:
 `:before'       (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
 `:after'        (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION 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-until' (lambda (&rest r) (or  (apply FUNCTION r) (apply OLDFUN 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)
           (advice--make where function (gv-deref ref) props))))
 
+;;;###autoload
 (defmacro remove-function (place function)
   "Remove the FUNCTION piece of advice from PLACE.
 If FUNCTION was not added to PLACE, do nothing.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index f5e1abdd546..8e15ec6584e 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -574,21 +574,20 @@ NOARG must be t when this macro is used outside `gud-def'"
     (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
     ,(when (not noarg) 'arg)))
 
-(defun gdb--check-interpreter (proc string)
+(defun gdb--check-interpreter (filter proc string)
   (unless (zerop (length string))
-    (let ((filter (process-get proc 'gud-normal-filter)))
-      (set-process-filter proc filter)
-      (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
-        ;; Apparently we're not running with -i=mi.
-        (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
-          (message msg)
-          (setq string (concat (propertize msg 'font-lock-face 'error)
-                               "\n" string)))
-        ;; Use the old gud-gbd filter, not because it works, but because it
-        ;; will properly display GDB's answers rather than hanging waiting for
-        ;; answers that aren't coming.
-        (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
-      (funcall filter proc string))))
+    (remove-function (process-filter proc) #'gdb--check-interpreter)
+    (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
+      ;; Apparently we're not running with -i=mi.
+      (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
+        (message msg)
+        (setq string (concat (propertize msg 'font-lock-face 'error)
+                             "\n" string)))
+      ;; Use the old gud-gbd filter, not because it works, but because it
+      ;; will properly display GDB's answers rather than hanging waiting for
+      ;; answers that aren't coming.
+      (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+    (funcall filter proc string)))
 
 (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
   ;; with -i=mi.
   (let ((proc (get-buffer-process gud-comint-buffer)))
-    (process-put proc 'gud-normal-filter (process-filter proc))
-    (set-process-filter proc #'gdb--check-interpreter))
+    (add-function :around (process-filter proc) #'gdb--check-interpreter))
 
   (set (make-local-variable 'gud-minor-mode) 'gdbmi)
   (set (make-local-variable 'gdb-control-level) 0)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4e31c5e827c..6076f88dea6 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3387,9 +3387,6 @@ ACTIVATEP non-nil means activate mouse motion events."
 
 ;;; Tips for `gud'
 
-(defvar gud-tooltip-original-filter nil
-  "Process filter to restore after GUD output has been received.")
-
 (defvar gud-tooltip-dereference nil
   "Non-nil means print expressions with a `*' in front of them.
 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.
 (defun gud-tooltip-process-output (process output)
   "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)
                 (or gud-tooltip-echo-area tooltip-use-echo-area)))
 
@@ -3490,8 +3487,8 @@ so they have been disabled."))
                       (gdb-input
                        (concat cmd "\n")
                        `(lambda () (gdb-tooltip-print ,expr))))
-                  (setq gud-tooltip-original-filter (process-filter process))
-                  (set-process-filter process 'gud-tooltip-process-output)
+                  (add-function :override (process-filter process)
+                                #'gud-tooltip-process-output)
                   (gud-basic-call cmd))
                 expr))))))))
 
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index de7ca32befe..4a227db7164 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -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
 output is passed to the filter `inferior-octave-output-digest'."
   (let* ((proc inferior-octave-process)
-         (filter (process-filter proc))
          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)
     (unwind-protect
         (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
             (accept-process-output proc))
           (setq list (cdr list)))
-      (set-process-filter proc filter))))
+      (remove-function (process-filter proc)
+                       #'inferior-octave-output-digest))))
 
 (defun inferior-octave-directory-tracker (string)
   "Tracks `cd' commands issued to the inferior Octave process.
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 85e4172c8fe..8971e97a44e 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1770,7 +1770,8 @@ This function must be called from the source code buffer."
                                              real-file))
     (with-current-buffer buffer
       (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)
       ;; (prolog-build-prolog-command compilep file real-file first-line))
       (while (and prolog-process-flag
@@ -1781,7 +1782,8 @@ This function must be called from the source code buffer."
       (insert (if compilep
                   "\nCompilation finished.\n"
                 "\nConsulted.\n"))
-      (set-process-filter process old-filter))))
+      (remove-function (process-filter process)
+                       #'prolog-consult-compile-filter))))
 
 (defvar compilation-error-list)
 
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 2ad44b4b1c8..37c3cd37a6c 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -35,7 +35,6 @@
 ;;;; Internal Variables
 
 (defvar xscheme-previous-mode)
-(defvar xscheme-previous-process-state)
 (defvar xscheme-last-input-end)
 
 (defvar xscheme-process-command-line nil
@@ -388,8 +387,6 @@ with no args, if that value is non-nil.
   (if (not preserve)
       (let ((previous-mode major-mode))
         (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)
         (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-last-input-end) (make-marker))
           (let ((process (get-buffer-process buffer)))
-            (if process
-                (progn
-                  (setq xscheme-process-name (process-name process))
-                  (setq xscheme-previous-process-state
-                        (cons (process-filter process)
-                              (process-sentinel process)))
-                  (xscheme-process-filter-initialize t)
-                  (xscheme-mode-line-initialize xscheme-buffer-name)
-                  (set-process-sentinel process 'xscheme-process-sentinel)
-                  (set-process-filter process 'xscheme-process-filter))
-                (setq xscheme-previous-process-state (cons nil nil)))))))
+            (when process
+              (setq-local xscheme-process-name (process-name process))
+              ;; FIXME: Use add-function!
+              (xscheme-process-filter-initialize t)
+              (xscheme-mode-line-initialize xscheme-buffer-name)
+              (add-function :override (process-sentinel process)
+                            #'xscheme-process-sentinel)
+              (add-function :override (process-filter process)
+                            #'xscheme-process-filter))))))
   (scheme-interaction-mode-initialize)
   (scheme-mode-variables)
   (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
 
 (defun exit-scheme-interaction-mode ()
-  "Take buffer out of scheme interaction mode"
+  "Take buffer out of scheme interaction mode."
   (interactive)
   (if (not (derived-mode-p 'scheme-interaction-mode))
       (error "Buffer not in scheme interaction mode"))
-  (let ((previous-state xscheme-previous-process-state))
-    (funcall xscheme-previous-mode)
-    (let ((process (get-buffer-process (current-buffer))))
-      (if process
-          (progn
-            (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))))))))
+  (funcall xscheme-previous-mode)
+  (let ((process (get-buffer-process (current-buffer))))
+    (when process
+      (remove-function (process-sentinel process) #'xscheme-process-sentinel)
+      (remove-function (process-filter process) #'xscheme-process-filter))))
 
 (defvar scheme-interaction-mode-commands-alist nil)
 (defvar scheme-interaction-mode-map nil)
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."
 
 (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))
   (if (not (string-match vc-cvs-annotate-first-line-re string))
       ;; Still waiting for the first real line.
       (process-put process 'output string)
-    (let ((vc-filter (process-get process 'vc-filter)))
-      (set-process-filter process vc-filter)
-      (funcall vc-filter process (substring string (match-beginning 0))))))
+    (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
+    (funcall filter process (substring string (match-beginning 0)))))
 
 (defun vc-cvs-annotate-command (file buffer &optional revision)
   "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)))
     (if proc
         ;; If running asynchronously, use a process filter.
-        (progn
-          (process-put proc 'vc-filter (process-filter proc))
-          (set-process-filter proc 'vc-cvs-annotate-process-filter))
+        (add-function :around (process-filter proc)
+                      #'vc-cvs-annotate-process-filter)
       (with-current-buffer buffer
         (goto-char (point-min))
         (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 @@
-;;; 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.
 
@@ -182,32 +182,29 @@ Another is that undo information is not kept."
 
 (defvar vc-sentinel-movepoint)          ;Dynamically scoped.
 
-(defun vc-process-sentinel (p s)
-  (let ((previous (process-get p 'vc-previous-sentinel))
-        (buf (process-buffer p)))
+(defun vc--process-sentinel (p code)
+  (let ((buf (process-buffer p)))
     ;; Impatient users sometime kill "slow" buffers; check liveness
     ;; to avoid "error in process sentinel: Selecting deleted buffer".
     (when (buffer-live-p buf)
-      (when previous (funcall previous p s))
       (with-current-buffer buf
         (setq mode-line-process
               (let ((status (process-status p)))
                 ;; Leave mode-line uncluttered, normally.
                 (unless (eq 'exit 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.
           (save-excursion
-            (goto-char (process-mark p))
-            (let ((cmds (process-get p 'vc-sentinel-commands)))
-              (process-put p 'vc-sentinel-commands nil)
-              (dolist (cmd cmds)
+            (goto-char m)
                 ;; 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))))
+            (vc-exec-after code)
+            (move-marker m (point)))
           ;; But sometimes the sentinels really want to move point.
           (when vc-sentinel-movepoint
             (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)
   "Eval CODE when the current buffer's process is done.
 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))))
     (cond
      ;; 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))
       ;; Make sure we've read the process's output before going further.
       (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
      ((eq (process-status proc) 'run)
       (vc-set-mode-line-busy-indicator)
-      (let ((previous (process-sentinel proc)))
-        (unless (eq previous 'vc-process-sentinel)
-          (process-put proc 'vc-previous-sentinel previous))
-        (set-process-sentinel proc 'vc-process-sentinel))
-      (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))))
+      (letrec ((fun (lambda (p _msg)
+                      (remove-function (process-sentinel p) fun)
+                      (vc--process-sentinel p code))))
+        (add-function :after (process-sentinel proc) fun)))
      (t (error "Unexpected process state"))))
   nil)
 
@@ -388,6 +381,8 @@ Display the buffer in some window, but don't select it."
         (set-window-start window new-window-start))
     buffer))
 
+(defvar compilation-error-regexp-alist)
+
 (defun vc-compilation-mode (backend)
   "Setup `compilation-mode' after with the appropriate `compilation-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))))
         ;; Make the right thing happen in transient-mark-mode.
         (mark-active nil))
-    (list point-context mark-context nil)))
+    (list point-context mark-context)))
 
 (defun vc-restore-buffer-context (context)
   "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)
 (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)
   "If FILE is in the current buffer, either revert or unvisit it.
 The choice between revert (to see expanded keywords) and unvisit