-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions
;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
(provide 'advice-preload)
;; During a normal load this is a noop:
(require 'advice-preload "advice.el")
-
+(eval-when-compile (require 'cl-lib))
;; @@ Variable definitions:
;; ========================
(funcall fUnCtIoN tReE))
(t tReE)))
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
- "Return a copy of the list structure of TREE."
- (cond ((consp tree)
- (cons (ad-copy-tree (car tree))
- (ad-copy-tree (cdr tree))))
- (t tree)))
-
-(defmacro ad-dolist (varform &rest body)
- "A Common-Lisp-style dolist iterator with the following syntax:
-
- (ad-dolist (VAR INIT-FORM [RESULT-FORM])
- BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration. If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise. The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
- (let ((expansion
- `(let ((ad-dO-vAr ,(car (cdr varform)))
- ,(car varform))
- (while ad-dO-vAr
- (setq ,(car varform) (car ad-dO-vAr))
- ,@body
- ;;work around a backquote bug:
- ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
- ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
- ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
- ,(car (cdr (cdr varform))))))
- ;;ok, this wastes some cons cells but only during compilation:
- (if (catch 'contains-return
- (ad-substitute-tree
- (function (lambda (subtree)
- (cond ((eq (car-safe subtree) 'ad-dolist))
- ((eq (car-safe subtree) 'ad-do-return)
- (throw 'contains-return t)))))
- 'identity body)
- nil)
- `(catch 'ad-dO-eXiT ,expansion)
- expansion)))
-
-(defmacro ad-do-return (value)
- `(throw 'ad-dO-eXiT ,value))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
- (put 'ad-dolist 'lisp-indent-hook 1))
-
-
;; @@ Save real definitions of subrs used by Advice:
;; =================================================
;; Advice depends on the real, unmodified functionality of various subrs,
ad-advised-functions)))
(defmacro ad-do-advised-functions (varform &rest body)
- "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
+ "`dolist'-style iterator that maps over `ad-advised-functions'.
\(ad-do-advised-functions (VAR [RESULT-FORM])
BODY-FORM...)
On each iteration VAR will be bound to the name of an advised function
\(a symbol)."
- `(ad-dolist (,(car varform)
+ `(cl-dolist (,(car varform)
ad-advised-functions
,(car (cdr varform)))
- (setq ,(car varform) (intern (car ,(car varform))))
- ,@body))
+ (setq ,(car varform) (intern (car ,(car varform))))
+ ,@body))
(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
(put 'ad-do-advised-functions 'lisp-indent-hook 1))
`(put ,function 'ad-advice-info ,advice-info))
(defmacro ad-copy-advice-info (function)
- `(ad-copy-tree (get ,function 'ad-advice-info)))
+ `(copy-tree (get ,function 'ad-advice-info)))
(defmacro ad-is-advised (function)
"Return non-nil if FUNCTION has any advice info associated with it.
(defun ad-has-enabled-advice (function class)
"True if at least one of FUNCTION's advices in CLASS is enabled."
- (ad-dolist (advice (ad-get-advice-info-field function class))
- (if (ad-advice-enabled advice) (ad-do-return t))))
+ (cl-dolist (advice (ad-get-advice-info-field function class))
+ (if (ad-advice-enabled advice) (cl-return t))))
(defun ad-has-redefining-advice (function)
"True if FUNCTION's advice info defines at least 1 redefining advice.
(defun ad-has-any-advice (function)
"True if the advice info of FUNCTION defines at least one advice."
(and (ad-is-advised function)
- (ad-dolist (class ad-advice-classes nil)
+ (cl-dolist (class ad-advice-classes nil)
(if (ad-get-advice-info-field function class)
- (ad-do-return t)))))
+ (cl-return t)))))
(defun ad-get-enabled-advices (function class)
"Return the list of enabled advices of FUNCTION in CLASS."
(let (enabled-advices)
- (ad-dolist (advice (ad-get-advice-info-field function class))
+ (dolist (advice (ad-get-advice-info-field function class))
(if (ad-advice-enabled advice)
(push advice enabled-advices)))
(reverse enabled-advices)))
(ad-do-advised-functions (function)
(if (or (null predicate)
(funcall predicate function))
- (ad-do-return function)))
+ (cl-return function)))
(error "ad-read-advised-function: %s"
"There are no qualifying advised functions")))
(let* ((ad-pReDiCaTe predicate)
class of FUNCTION)."
(setq default
(or default
- (ad-dolist (class ad-advice-classes)
+ (cl-dolist (class ad-advice-classes)
(if (ad-get-advice-info-field function class)
- (ad-do-return class)))
+ (cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
(format "%s (default %s): " (or prompt "Class") default)
If CLASS is `any' all valid advice classes will be checked."
(if (ad-is-advised function)
(let (found-advice)
- (ad-dolist (advice-class ad-advice-classes)
+ (cl-dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
(setq found-advice
- (ad-dolist (advice (ad-get-advice-info-field
+ (cl-dolist (advice (ad-get-advice-info-field
function advice-class))
(if (or (and (stringp name)
(string-match
name (symbol-name
(ad-advice-name advice))))
(eq name (ad-advice-name advice)))
- (ad-do-return advice)))))
- (if found-advice (ad-do-return found-advice))))))
+ (cl-return advice)))))
+ (if found-advice (cl-return found-advice))))))
(defun ad-enable-advice-internal (function class name flag)
"Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
FUNCTION was not advised)."
(if (ad-is-advised function)
(let ((matched-advices 0))
- (ad-dolist (advice-class ad-advice-classes)
+ (dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
- (ad-dolist (advice (ad-get-advice-info-field
- function advice-class))
+ (dolist (advice (ad-get-advice-info-field
+ function advice-class))
(cond ((or (and (stringp name)
(string-match
name (symbol-name (ad-advice-name advice))))
(if origdoc (setq paragraphs (list origdoc)))
(unless (eq style 'plain)
(push (concat "This " origtype " is advised.") paragraphs))
- (ad-dolist (class ad-advice-classes)
- (ad-dolist (advice (ad-get-enabled-advices function class))
+ (dolist (class ad-advice-classes)
+ (dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
(ad-make-single-advice-docstring advice class style))
(if advice-docstring
(defun ad-advised-arglist (function)
"Find first defined arglist in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((arglist (ad-arglist (ad-advice-definition advice))))
(if arglist
;; We found the first one, use it:
- (ad-do-return arglist)))))
+ (cl-return arglist)))))
(defun ad-advised-interactive-form (function)
"Find first interactive form in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((interactive-form
(ad-interactive-form (ad-advice-definition advice))))
(if interactive-form
;; We found the first one, use it:
- (ad-do-return interactive-form)))))
+ (cl-return interactive-form)))))
;; @@@ Putting it all together:
;; ============================
should be modified. The assembled function will be returned."
(let (before-forms around-form around-form-protected after-forms definition)
- (ad-dolist (advice befores)
- (cond ((and (ad-advice-protected advice)
- before-forms)
- (setq before-forms
- `((unwind-protect
- ,(ad-prognify before-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq before-forms
- (append before-forms
- (ad-body-forms (ad-advice-definition advice)))))))
+ (dolist (advice befores)
+ (cond ((and (ad-advice-protected advice)
+ before-forms)
+ (setq before-forms
+ `((unwind-protect
+ ,(ad-prognify before-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq before-forms
+ (append before-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
(setq around-form `(setq ad-return-value ,orig))
- (ad-dolist (advice (reverse arounds))
- ;; If any of the around advices is protected then we
- ;; protect the complete around advice onion:
- (if (ad-advice-protected advice)
- (setq around-form-protected t))
- (setq around-form
- (ad-substitute-tree
- (function (lambda (form) (eq form 'ad-do-it)))
- (function (lambda (form) around-form))
- (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
+ (dolist (advice (reverse arounds))
+ ;; If any of the around advices is protected then we
+ ;; protect the complete around advice onion:
+ (if (ad-advice-protected advice)
+ (setq around-form-protected t))
+ (setq around-form
+ (ad-substitute-tree
+ (function (lambda (form) (eq form 'ad-do-it)))
+ (function (lambda (form) around-form))
+ (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
(setq after-forms
(if (and around-form-protected before-forms)
,(ad-prognify before-forms)
,around-form))
(append before-forms (list around-form))))
- (ad-dolist (advice afters)
- (cond ((and (ad-advice-protected advice)
- after-forms)
- (setq after-forms
- `((unwind-protect
- ,(ad-prognify after-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq after-forms
- (append after-forms
- (ad-body-forms (ad-advice-definition advice)))))))
+ (dolist (advice afters)
+ (cond ((and (ad-advice-protected advice)
+ after-forms)
+ (setq after-forms
+ `((unwind-protect
+ ,(ad-prognify after-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq after-forms
+ (append after-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
(setq definition
`(,@(if (memq type '(macro special-form)) '(macro))
(nth 2 cache-id)))))
(defun ad-verify-cache-class-id (cache-class-id advices)
- (ad-dolist (advice advices (null cache-class-id))
+ (cl-dolist (advice advices (null cache-class-id))
(if (ad-advice-enabled advice)
(if (eq (car cache-class-id) (ad-advice-name advice))
(setq cache-class-id (cdr cache-class-id))
- (ad-do-return nil)))))
+ (cl-return nil)))))
;; There should be a way to monitor if and why a cache verification failed
;; in order to determine whether a certain preactivation could be used or
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
- (declare (doc-string 3))
+ (declare (doc-string 3)
+ (debug (&define name ;; thing being advised.
+ (name ;; class is [&or "before" "around" "after"
+ ;; "activation" "deactivation"]
+ name ;; name of advice
+ &rest sexp ;; optional position and flags
+ )
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
(if (not (ad-name-p function))
(error "defadvice: Invalid function name: %s" function))
(let* ((class (car args))
;;; Code:
(require 'macroexp)
-
-;;; Bug reporting
-
-(defalias 'edebug-submit-bug-report 'report-emacs-bug)
+(eval-when-compile (require 'cl-lib))
;;; Options
;; Select WINDOW if it is provided and still exists. Otherwise,
;; if buffer is currently shown in several windows, choose one.
;; Otherwise, find a new window, possibly splitting one.
+ ;; FIXME: We should probably just be using `pop-to-buffer'.
(setq window
(cond
((and (edebug-window-live-p window)
((eq (window-buffer (selected-window)) buffer)
;; Selected window already displays BUFFER.
(selected-window))
- ((edebug-get-buffer-window buffer))
+ ((get-buffer-window buffer 0))
((one-window-p 'nomini)
;; When there's one window only, split it.
(split-window))
window-info)
(set-window-configuration window-info)))
-(defalias 'edebug-get-buffer-window 'get-buffer-window)
-(defalias 'edebug-sit-for 'sit-for)
-(defalias 'edebug-input-pending-p 'input-pending-p)
-
-
;;; Redefine read and eval functions
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
;; Save the original read function
-(or (fboundp 'edebug-original-read)
- (defalias 'edebug-original-read (symbol-function 'read)))
+(defalias 'edebug-original-read
+ (symbol-function (if (fboundp 'edebug-original-read)
+ 'edebug-original-read 'read)))
(defun edebug-read (&optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object.
(defvar-local edebug-form-data nil
"A list of entries associating symbols with buffer regions.
-This is an automatic buffer local variable. Each entry looks like:
-\(SYMBOL BEGIN-MARKER END-MARKER). The markers
+Each entry is an `edebug--form-data' struct with fields:
+SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
are at the beginning and end of an entry level form and SYMBOL is
a symbol that holds all edebug related information for the form on its
property list.
be stored in the definitions themselves rather than in the property
list of a symbol.")
-;; FIXME: Use cl-defstruct.
-
-(defun edebug-make-form-data-entry (symbol begin end)
- (list symbol begin end))
-
-(defsubst edebug-form-data-name (entry)
- (car entry))
-
-(defsubst edebug-form-data-begin (entry)
- (nth 1 entry))
-
-(defsubst edebug-form-data-end (entry)
- (nth 2 entry))
+(cl-defstruct (edebug--form-data
+ ;; Some callers expect accessors to return nil when passed nil.
+ (:type list)
+ (:constructor edebug--make-form-data-entry (name begin end))
+ (:predicate nil) (:constructor nil) (:copier nil))
+ name begin end)
(defsubst edebug-set-form-data-entry (entry name begin end)
- (setcar entry name) ;; In case name is changed.
- (set-marker (nth 1 entry) begin)
- (set-marker (nth 2 entry) end))
+ (setf (edebug--form-data-name entry) name) ;; In case name is changed.
+ (set-marker (edebug--form-data-begin entry) begin)
+ (set-marker (edebug--form-data-end entry) end))
(defun edebug-get-form-data-entry (pnt &optional end-point)
;; Find the edebug form data entry which is closest to PNT.
;; Return `nil' if none found.
(let ((rest edebug-form-data)
closest-entry
- (closest-dist 999999)) ;; need maxint here
+ (closest-dist 999999)) ;; Need maxint here.
(while (and rest (< 0 closest-dist))
(let* ((entry (car rest))
- (begin (edebug-form-data-begin entry))
+ (begin (edebug--form-data-begin entry))
(dist (- pnt begin)))
(setq rest (cdr rest))
(if (and (<= 0 dist)
(< dist closest-dist)
(or (not end-point)
- (= end-point (edebug-form-data-end entry)))
- (<= pnt (edebug-form-data-end entry)))
+ (= end-point (edebug--form-data-end entry)))
+ (<= pnt (edebug--form-data-end entry)))
(setq closest-dist dist
closest-entry entry))))
closest-entry))
;; and find an entry given a symbol, which should be just assq.
(defun edebug-form-data-symbol ()
-;; Return the edebug data symbol of the form where point is in.
-;; If point is not inside a edebuggable form, cause error.
- (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
+ "Return the edebug data symbol of the form where point is in.
+If point is not inside a edebuggable form, cause error."
+ (or (edebug--form-data-name (edebug-get-form-data-entry (point)))
(error "Not inside instrumented form")))
(defun edebug-make-top-form-data-entry (new-entry)
;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
(edebug-clear-form-data-entry new-entry)
- (setq edebug-form-data (cons new-entry edebug-form-data)))
+ (push new-entry edebug-form-data))
(defun edebug-clear-form-data-entry (entry)
-;; If non-nil, clear ENTRY out of the form data.
-;; Maybe clear the markers and delete the symbol's edebug property?
+ "If non-nil, clear ENTRY out of the form data.
+Maybe clear the markers and delete the symbol's edebug property?"
(if entry
(progn
;; Instead of this, we could just find all contained forms.
;; Set this marker before parsing.
(edebug-form-begin-marker
(if form-data-entry
- (edebug-form-data-begin form-data-entry)
+ (edebug--form-data-begin form-data-entry)
;; Buffer must be current-buffer for this to work:
(set-marker (make-marker) form-begin))))
;; For definitions.
;; (edebug-containing-def-name edebug-def-name)
;; Get name from form-data, if any.
- (edebug-old-def-name (edebug-form-data-name form-data-entry))
+ (edebug-old-def-name (edebug--form-data-name form-data-entry))
edebug-def-name
edebug-def-args
edebug-def-interactive
;; In the latter case, pointers to the entry remain eq.
(if (not form-data-entry)
(setq form-data-entry
- (edebug-make-form-data-entry
+ (edebug--make-form-data-entry
edebug-def-name
edebug-form-begin-marker
;; Buffer must be current-buffer.
(if edebug-error-point
(goto-char edebug-error-point))
(apply 'edebug-syntax-error args))
- (funcall 'throw 'no-match args)))
+ (throw 'no-match args)))
(defun edebug-match (cursor specs)
;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
;; Standard functions that take function-forms arguments.
-(def-edebug-spec mapcar (function-form form))
-(def-edebug-spec mapconcat (function-form form form))
-(def-edebug-spec mapatoms (function-form &optional form))
-(def-edebug-spec apply (function-form &rest form))
-(def-edebug-spec funcall (function-form &rest form))
;; FIXME? The manual uses this form (maybe that's just for illustration?):
;; (def-edebug-spec let
&or ("quote" edebug-\`) def-form))
;; New byte compiler.
-(def-edebug-spec defsubst defun)
-(def-edebug-spec dont-compile t)
-(def-edebug-spec eval-when-compile t)
-(def-edebug-spec eval-and-compile t)
(def-edebug-spec save-selected-window t)
(def-edebug-spec save-current-buffer t)
-(def-edebug-spec delay-mode-hooks t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-message t)
-(def-edebug-spec with-syntax-table t)
-(def-edebug-spec push (form sexp))
-(def-edebug-spec pop (sexp))
-
-(def-edebug-spec 1value (form))
-(def-edebug-spec noreturn (form))
-
;; Anything else?
-
-;; Some miscellaneous specs for macros in public packages.
-;; Send me yours.
-
-;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
-
-(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice
- (&define name ;; thing being advised.
- (name ;; class is [&or "before" "around" "after"
- ;; "activation" "deactivation"]
- name ;; name of advice
- &rest sexp ;; optional position and flags
- )
- [&optional stringp]
- [&optional ("interactive" interactive)]
- def-body))
-
-(def-edebug-spec easy-menu-define (symbolp body))
-
-(def-edebug-spec with-custom-print body)
-
-
;;; The debugger itself
(defvar edebug-active nil) ;; Non-nil when edebug is active
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-(defvar edebug-outside-overriding-local-map)
-(defvar edebug-outside-overriding-terminal-local-map)
(defvar edebug-outside-pre-command-hook)
(defvar edebug-outside-post-command-hook)
(1+ (aref edebug-freq-count before-index)))
(if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
- (edebug-input-pending-p))
+ (input-pending-p))
(edebug-debugger before-index 'before nil)))
before-index)
(if edebug-test-coverage (edebug--update-coverage after-index value))
(if (and (eq edebug-execution-mode 'Go-nonstop)
- (not (edebug-input-pending-p)))
+ (not (input-pending-p)))
;; Just return result.
value
(edebug-debugger after-index 'after value)
;; or break, or input is pending,
(if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
edebug-break
- (edebug-input-pending-p))
+ (input-pending-p))
(edebug--display value offset-index arg-mode)) ; <---------- display
value)))
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string)
(cursor-in-echo-area nil)
- (unread-command-events unread-command-events)
+ (unread-command-events nil)
;; any others??
)
(setq-default cursor-in-non-selected-windows t)
(edebug-adjust-window (cdr edebug-window-data)))
;; Test if there is input, not including keyboard macros.
- (if (edebug-input-pending-p)
+ (if (input-pending-p)
(progn
(setq edebug-execution-mode 'step
edebug-stop t)
(t (message "")))
- (setq unread-command-events nil)
(if (eq 'after arg-mode)
(progn
;; Display result of previous evaluation.
(if (and edebug-break
(not (eq edebug-execution-mode 'Continue-fast)))
- (edebug-sit-for edebug-sit-for-seconds)) ; Show message.
+ (sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
(cond
(edebug-break
(cond
((eq edebug-execution-mode 'continue)
- (edebug-sit-for edebug-sit-for-seconds))
- ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
+ (sit-for edebug-sit-for-seconds))
+ ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
(t (setq edebug-stop t))))
;; not edebug-break
((eq edebug-execution-mode 'trace)
- (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ (sit-for edebug-sit-for-seconds)) ; Force update and pause.
((eq edebug-execution-mode 'Trace-fast)
- (edebug-sit-for 0))) ; Force update and continue.
+ (sit-for 0))) ; Force update and continue.
(unwind-protect
(if (or edebug-stop
;; Reset the edebug-window-data to whatever it is now.
(let ((window (if (eq (window-buffer) edebug-buffer)
(selected-window)
- (edebug-get-buffer-window edebug-buffer))))
+ (get-buffer-window edebug-buffer))))
;; Remember window-start for edebug-buffer, if still displayed.
(if window
(progn
(goto-char edebug-buffer-outside-point))
;; ... nothing more.
)
+ ;; Could be an option to keep eval display up.
+ (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
(setq
(edebug-outside-map (current-local-map))
- (edebug-outside-overriding-local-map overriding-local-map)
- (edebug-outside-overriding-terminal-local-map
- overriding-terminal-local-map)
-
;; Save the outside value of executing macro. (here??)
(edebug-outside-executing-macro executing-kbd-macro)
(edebug-outside-pre-command-hook
(last-nonmenu-event nil)
(track-mouse nil)
+ (standard-output t)
+ (standard-input t)
+
;; Don't keep reading from an executing kbd macro
;; within edebug unless edebug-continue-kbd-macro is
;; non-nil. Again, local binding may not be best.
(setq signal-hook-function 'edebug-signal)
(if edebug-backtrace-buffer
(kill-buffer edebug-backtrace-buffer))
- ;; Could be an option to keep eval display up.
- (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
;; Remember selected-window after recursive-edit.
;; (setq edebug-inside-window (selected-window))
(defun edebug-adjust-window (old-start)
;; If pos is not visible, adjust current window to fit following context.
-;;; (message "window: %s old-start: %s window-start: %s pos: %s"
-;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
+ ;; (message "window: %s old-start: %s window-start: %s pos: %s"
+ ;; (selected-window) old-start (window-start) (point)) (sit-for 5)
(if (not (pos-visible-in-window-p))
(progn
;; First try old-start
(set-window-start (selected-window) old-start))
(if (not (pos-visible-in-window-p))
(progn
-;; (message "resetting window start") (sit-for 2)
+ ;; (message "resetting window start") (sit-for 2)
(set-window-start
(selected-window)
(save-excursion
(current-buffer) (point)
(if (marker-buffer (edebug-mark-marker))
(marker-position (edebug-mark-marker)) "<not set>"))
- (edebug-sit-for arg)
+ (sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
(save-excursion
(down-list 1)
(if (looking-at "\(")
- (edebug-form-data-name
+ (edebug--form-data-name
(edebug-get-form-data-entry (point)))
(edebug-original-read (current-buffer))))))
(edebug-instrument-function func))))
(defun edebug-eval (expr)
;; Are there cl lexical variables active?
- (eval (if (bound-and-true-p cl-debug-env)
+ (eval (if (and (bound-and-true-p cl-debug-env)
+ (fboundp 'cl-macroexpand-all))
(cl-macroexpand-all expr cl-debug-env)
expr)
lexical-binding))
"In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
The buffer is created if it does not exist.
You must include newlines in FMT to break lines, but one newline is appended."
-;; e.g.
-;; (edebug-trace-display "*trace-point*"
-;; "saving: point = %s window-start = %s"
-;; (point) (window-start))
+ ;; e.g.
+ ;; (edebug-trace-display "*trace-point*"
+ ;; "saving: point = %s window-start = %s"
+ ;; (point) (window-start))
(let* ((oldbuf (current-buffer))
(selected-window (selected-window))
(buffer (get-buffer-create buf-name))
buf-window)
-;; (message "before pop-to-buffer") (sit-for 1)
+ ;; (message "before pop-to-buffer") (sit-for 1)
(edebug-pop-to-buffer buffer)
(setq truncate-lines t)
(setq buf-window (selected-window))
(vertical-motion (- 1 (window-height)))
(set-window-start buf-window (point))
(goto-char (point-max))
-;; (set-window-point buf-window (point))
-;; (edebug-sit-for 0)
+ ;; (set-window-point buf-window (point))
+ ;; (sit-for 0)
(bury-buffer buffer)
(select-window selected-window)
(set-buffer oldbuf))
;; Insert all the indices for this line.
(forward-line 1)
(setq start-of-count-line (point)
- first-index i ; really last index for line above this one.
- last-count -1) ; cause first count to always appear.
+ first-index i ; Really, last index for line above this one.
+ last-count -1) ; Cause first count to always appear.
(insert ";#")
;; i == first-index still
(while (<= (setq i (1+ i)) last-index)
(let ((buffer-read-only nil))
(undo-boundary)
(edebug-display-freq-count)
- (setq unread-command-events (append unread-command-events (read-event)))
+ (setq unread-command-events
+ (append unread-command-events (list (read-event))))
;; Yuck! This doesn't seem to work at all for me.
(undo)))
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
\f
-;;; Byte-compiler
-
-;; Extension for bytecomp to resolve undefined function references.
-;; Requires new byte compiler.
-
-(eval-when-compile
- ;; The body of eval-when-compile seems to get evaluated with eval-defun.
- ;; We only want to evaluate when actually byte compiling.
- ;; But it is OK to evaluate as long as byte-compiler has been loaded.
- (if (featurep 'byte-compile) (progn
-
- (defun byte-compile-resolve-functions (funcs)
- "Say it is OK for the named functions to be unresolved."
- (mapc
- (function
- (lambda (func)
- (setq byte-compile-unresolved-functions
- (delq (assq func byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))))
- funcs)
- nil)
-
- '(defun byte-compile-resolve-free-references (vars)
- "Say it is OK for the named variables to be referenced."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-references
- (delq var byte-compile-free-references))))
- vars)
- nil)
-
- '(defun byte-compile-resolve-free-assignments (vars)
- "Say it is OK for the named variables to be assigned."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-assignments
- (delq var byte-compile-free-assignments))))
- vars)
- nil)
-
- (byte-compile-resolve-functions
- '(reporter-submit-bug-report
- edebug-gensym ;; also in cl.el
- ;; Interfaces to standard functions.
- edebug-original-eval-defun
- edebug-original-read
- edebug-get-buffer-window
- edebug-mark
- edebug-mark-marker
- edebug-input-pending-p
- edebug-sit-for
- edebug-prin1-to-string
- edebug-format
- ;; lemacs
- zmacs-deactivate-region
- popup-menu
- ;; CL
- cl-macroexpand-all
- ;; And believe it or not, the byte compiler doesn't know about:
- byte-compile-resolve-functions
- ))
-
- '(byte-compile-resolve-free-references
- '(read-expression-history
- read-expression-map))
-
- '(byte-compile-resolve-free-assignments
- '(read-expression-history))
-
- )))
-
-\f
;;; Autoloading of Edebug accessories
;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
HCoop / bpt / emacs.git / commitdiff