]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/edebug.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / emacs-lisp / edebug.el
index 5107ee60274e37ac3c9e68ae46757e97245fefb7..e3ade01a4a067de7f2cd321bf41e602a2fae0508 100644 (file)
@@ -1,7 +1,7 @@
 ;;; edebug.el --- a source-level debugger for Emacs Lisp
 
 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999,
-;;   2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Daniel LaLiberte <liberte@holonexus.org>
 ;; Maintainer: FSF
@@ -11,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -364,31 +364,39 @@ Return the result of the last expression in BODY."
 
 (defun edebug-pop-to-buffer (buffer &optional window)
   ;; Like pop-to-buffer, but select window where BUFFER was last shown.
-  ;; Select WINDOW if it provided and it still exists.  Otherwise,
+  ;; 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.
-  (setq window (if (and (windowp window) (edebug-window-live-p window)
-                       (eq (window-buffer window) buffer))
-                  window
-                (if (eq (window-buffer (selected-window)) buffer)
-                    (selected-window)
-                  (edebug-get-buffer-window buffer))))
-  (if window
-      (select-window window)
-    (if (one-window-p)
-       (split-window))
-    ;;      (message "next window: %s" (next-window)) (sit-for 1)
-    (if (eq (get-buffer-window edebug-trace-buffer) (next-window))
-       ;; Don't select trace window
-       nil
-      (select-window (next-window))))
-  (set-window-buffer (selected-window) buffer)
-  (set-window-hscroll (selected-window) 0);; should this be??
+  (setq window
+       (cond
+        ((and (edebug-window-live-p window)
+              (eq (window-buffer window) buffer))
+         window)
+        ((eq (window-buffer (selected-window)) buffer)
+         ;; Selected window already displays BUFFER.
+         (selected-window))
+        ((edebug-get-buffer-window buffer))
+        ((one-window-p 'nomini)
+         ;; When there's one window only, split it.
+         (split-window))
+        ((let ((trace-window (get-buffer-window edebug-trace-buffer)))
+           (catch 'found
+             (dolist (elt (window-list nil 'nomini))
+               (unless (or (eq elt (selected-window)) (eq elt trace-window)
+                           (window-dedicated-p elt))
+                 ;; Found a non-dedicated window not showing
+                 ;; `edebug-trace-buffer', use it.
+                 (throw 'found elt))))))
+        ;; All windows are dedicated or show `edebug-trace-buffer', split
+        ;; selected one.
+        (t (split-window))))
+  (select-window window)
+  (set-window-buffer window buffer)
+  (set-window-hscroll window 0);; should this be??
   ;; Selecting the window does not set the buffer until command loop.
   ;;(set-buffer buffer)
   )
 
-
 (defun edebug-get-displayed-buffer-points ()
   ;; Return a list of buffer point pairs, for all displayed buffers.
   (let (list)
@@ -1499,7 +1507,7 @@ expressions; a `progn' form will be returned enclosing these forms."
                    head (edebug-move-cursor cursor))))))
 
      ((consp head)
-      (if (eq (car head) ',)
+      (if (eq (car head) '\,)
          ;; The head of a form should normally be a symbol or a lambda
          ;; expression but it can also be an unquote form to be filled
          ;; before evaluation.  We evaluate the arguments anyway, on the
@@ -1656,7 +1664,7 @@ expressions; a `progn' form will be returned enclosing these forms."
      ((fboundp symbol)                 ; is it a predicate?
       (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
        ;; Special case for edebug-`.
-       (if (and (listp sexp) (eq (car sexp) ',))
+       (if (and (listp sexp) (eq (car sexp) '\,))
            (edebug-match cursor '(("," def-form)))
          (if (not (funcall symbol sexp))
              (edebug-no-match cursor symbol "failed"))
@@ -2094,8 +2102,8 @@ expressions; a `progn' form will be returned enclosing these forms."
 (def-edebug-spec edebug-\` (def-form))
 
 ;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec , (&or ("quote" edebug-\`) def-form))
-(def-edebug-spec ,@ (&define  ;; so (,@ form) is never wrapped.
+(def-edebug-spec \, (&or ("quote" edebug-\`) def-form))
+(def-edebug-spec \,@ (&define  ;; so (,@ form) is never wrapped.
                     &or ("quote" edebug-\`) def-form))
 
 ;; New byte compiler.
@@ -2731,7 +2739,7 @@ MSG is printed after `::::} '."
 
                  ;; Unrestore edebug-buffer's window-start, if displayed.
                  (let ((window (car edebug-window-data)))
-                   (if (and window (edebug-window-live-p window)
+                   (if (and (edebug-window-live-p window)
                             (eq (window-buffer) edebug-buffer))
                        (progn
                          (set-window-start window (cdr edebug-window-data)
@@ -2755,7 +2763,8 @@ MSG is printed after `::::} '."
              )                         ; if edebug-save-windows
 
            ;; Restore current buffer always, in case application needs it.
-           (set-buffer edebug-outside-buffer)
+           (if (buffer-name edebug-outside-buffer)
+               (set-buffer edebug-outside-buffer))
            ;; Restore point, and mark.
            ;; Needed even if restoring windows because
            ;; that doesn't restore point and mark in the current buffer.
@@ -2939,6 +2948,7 @@ MSG is printed after `::::} '."
                      (edebug-overlay-arrow))
                  (setq buffer-read-only edebug-buffer-read-only)
                  (use-local-map edebug-outside-map)
+                 (remove-hook 'kill-buffer-hook 'edebug-kill-buffer t)
                  )
              ;; gotta have a buffer to let its buffer local variables be set
              (get-buffer-create " bogus edebug buffer"))
@@ -3665,44 +3675,6 @@ Return the result of the last expression."
 
 ;;; Printing
 
-;; Replace printing functions.
-
-;; obsolete names
-(define-obsolete-function-alias 'edebug-install-custom-print-funcs
-    'edebug-install-custom-print "22.1")
-(define-obsolete-function-alias 'edebug-reset-print-funcs
-    'edebug-uninstall-custom-print "22.1")
-(define-obsolete-function-alias 'edebug-uninstall-custom-print-funcs
-    'edebug-uninstall-custom-print "22.1")
-
-(defun edebug-install-custom-print ()
-  "Replace print functions used by Edebug with custom versions."
-  ;; Modifying the custom print functions, or changing print-length,
-  ;; print-level, print-circle, custom-print-list or custom-print-vector
-  ;; have immediate effect.
-  (interactive)
-  (require 'cust-print)
-  (defalias 'edebug-prin1 'custom-prin1)
-  (defalias 'edebug-print 'custom-print)
-  (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
-  (defalias 'edebug-format 'custom-format)
-  (defalias 'edebug-message 'custom-message)
-  "Installed")
-
-(eval-and-compile
-  (defun edebug-uninstall-custom-print ()
-    "Replace edebug custom print functions with internal versions."
-    (interactive)
-    (defalias 'edebug-prin1 'prin1)
-    (defalias 'edebug-print 'print)
-    (defalias 'edebug-prin1-to-string 'prin1-to-string)
-    (defalias 'edebug-format 'format)
-    (defalias 'edebug-message 'message)
-    "Uninstalled")
-
-  ;; Default print functions are the same as Emacs'.
-  (edebug-uninstall-custom-print))
-
 
 (defun edebug-report-error (edebug-value)
   ;; Print an error message like command level does.
@@ -3749,6 +3721,12 @@ Return the result of the last expression."
 
 ;;; Read, Eval and Print
 
+(defalias 'edebug-prin1 'prin1)
+(defalias 'edebug-print 'print)
+(defalias 'edebug-prin1-to-string 'prin1-to-string)
+(defalias 'edebug-format 'format)
+(defalias 'edebug-message 'message)
+
 (defun edebug-eval-expression (edebug-expr)
   "Evaluate an expression in the outside environment.
 If interactive, prompt for the expression.
@@ -3942,8 +3920,18 @@ edebug-on-signal
 edebug-unwrap-results
 edebug-global-break-condition
 "
+  ;; If the user kills the buffer in which edebug is currently active,
+  ;; exit to top level, because the edebug command loop can't usefully
+  ;; continue running in such a case.
+  (add-hook 'kill-buffer-hook 'edebug-kill-buffer nil t)
   (use-local-map edebug-mode-map))
 
+(defun edebug-kill-buffer ()
+  "Used on `kill-buffer-hook' when Edebug is operating in a buffer of Lisp code."
+  (let (kill-buffer-hook)
+    (kill-buffer (current-buffer)))
+  (top-level))
+
 ;;; edebug eval list mode
 
 ;; A list of expressions and their evaluations is displayed in *edebug*.
@@ -4401,7 +4389,7 @@ With prefix argument, make it a temporary breakpoint."
 
   (defun byte-compile-resolve-functions (funcs)
     "Say it is OK for the named functions to be unresolved."
-    (mapcar
+    (mapc
      (function
       (lambda (func)
        (setq byte-compile-unresolved-functions