* 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.
+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)
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.
;; 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
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"))
'((: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\ 2\"\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)
`: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)))
(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.
(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)
;; 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)
;;; 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.")
; 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)))
(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))))))))
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))
(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.
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
(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)
;;;; Internal Variables
(defvar xscheme-previous-mode)
-(defvar xscheme-previous-process-state)
(defvar xscheme-last-input-end)
(defvar xscheme-process-command-line 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)
(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)
(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.
(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)
-;;; 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.
(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)))
(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.
((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)
(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
(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.
(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