diff options
| -rw-r--r-- | lisp/ChangeLog | 30 | ||||
| -rw-r--r-- | lisp/comint.el | 15 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 3 | ||||
| -rw-r--r-- | lisp/progmodes/gdb-mi.el | 30 | ||||
| -rw-r--r-- | lisp/progmodes/gud.el | 9 | ||||
| -rw-r--r-- | lisp/progmodes/octave-inf.el | 7 | ||||
| -rw-r--r-- | lisp/progmodes/prolog.el | 6 | ||||
| -rw-r--r-- | lisp/progmodes/xscheme.el | 39 | ||||
| -rw-r--r-- | lisp/vc/vc-cvs.el | 12 | ||||
| -rw-r--r-- | lisp/vc/vc-dispatcher.el | 45 |
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 |