mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 02:51:31 -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>
* 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)

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
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"))

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

@ -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.

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)
,(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)

9
lisp/progmodes/gud.el
View file

@ -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))))))))

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
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.

6
lisp/progmodes/prolog.el
View file

@ -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)

39
lisp/progmodes/xscheme.el
View file

@ -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)

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]")
(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)

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.
@ -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