Add GC bug investigation code
[bpt/emacs.git] / lisp / subr.el
index 745d0b2..5de69d9 100644 (file)
@@ -265,7 +265,9 @@ information about the function or macro; these go into effect
 during the evaluation of the `defun' or `defmacro' form.
 
 The possible values of SPECS are specified by
-`defun-declarations-alist' and `macro-declarations-alist'."
+`defun-declarations-alist' and `macro-declarations-alist'.
+
+For more information, see info node `(elisp)Declare Form'."
   ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
   nil)
 
@@ -1029,7 +1031,7 @@ of the position:
 `posn-area': A symbol identifying the area the event occurred in,
 or nil if the event occurred in the text area.
 `posn-point': The buffer position of the event.
-`posn-x-y': The pixel-based coordiates of the event.
+`posn-x-y': The pixel-based coordinates of the event.
 `posn-col-row': The estimated column and row corresponding to the
 position of the event.
 `posn-actual-col-row': The actual column and row corresponding to the
@@ -1461,7 +1463,7 @@ Each hook function definition is used to construct the FUN passed
 to the next hook function, if any.  The last (or \"outermost\")
 FUN is then called once."
   (declare (indent 2) (debug (form sexp body))
-           (obsolete "use a <foo>-function variable modified by add-function."
+           (obsolete "use a <foo>-function variable modified by `add-function'."
                      "24.4"))
   ;; We need those two gensyms because CL's lexical scoping is not available
   ;; for function arguments :-(
@@ -2206,14 +2208,16 @@ is nil and `use-dialog-box' is non-nil."
   ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
   ;; where all the keys were unbound (i.e. it somehow got triggered
   ;; within read-key, apparently).  I had to kill it.
-  (let ((answer 'recenter))
+  (let ((answer 'recenter)
+       (padded (lambda (prompt &optional dialog)
+                 (let ((l (length prompt)))
+                   (concat prompt
+                           (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+                               "" " ")
+                           (if dialog "" "(y or n) "))))))
     (cond
      (noninteractive
-      (setq prompt (concat prompt
-                           (if (or (zerop (length prompt))
-                                   (eq ?\s (aref prompt (1- (length prompt)))))
-                               "" " ")
-                           "(y or n) "))
+      (setq prompt (funcall padded prompt))
       (let ((temp-prompt prompt))
        (while (not (memq answer '(act skip)))
          (let ((str (read-string temp-prompt)))
@@ -2224,14 +2228,10 @@ is nil and `use-dialog-box' is non-nil."
      ((and (display-popup-menus-p)
           (listp last-nonmenu-event)
           use-dialog-box)
-      (setq answer
-           (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+      (setq prompt (funcall padded prompt t)
+           answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
      (t
-      (setq prompt (concat prompt
-                           (if (or (zerop (length prompt))
-                                   (eq ?\s (aref prompt (1- (length prompt)))))
-                               "" " ")
-                           "(y or n) "))
+      (setq prompt (funcall padded prompt))
       (while
           (let* ((scroll-actions '(recenter scroll-up scroll-down
                                   scroll-other-window scroll-other-window-down))
@@ -2264,9 +2264,7 @@ is nil and `use-dialog-box' is non-nil."
         (discard-input))))
     (let ((ret (eq answer 'act)))
       (unless noninteractive
-        ;; FIXME this prints one too many spaces, since prompt
-        ;; already ends in a space.  Eg "... (y or n)  y".
-        (message "%s %s" prompt (if ret "y" "n")))
+        (message "%s%c" prompt (if ret ?y ?n)))
       ret)))
 
 \f
@@ -4294,29 +4292,34 @@ lookup sequence then continues."
     ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
     ;; in a cycle.
     (fset clearfun
-          (lambda ()
-            (with-demoted-errors "set-transient-map PCH: %S"
-              (unless (cond
-                       ((not (eq map (cadr overriding-terminal-local-map)))
-                        ;; There's presumably some other transient-map in
-                        ;; effect.  Wait for that one to terminate before we
-                        ;; remove ourselves.
-                        ;; For example, if isearch and C-u both use transient
-                        ;; maps, then the lifetime of the C-u should be nested
-                        ;; within isearch's, so the pre-command-hook of
-                        ;; isearch should be suspended during the C-u one so
-                        ;; we don't exit isearch just because we hit 1 after
-                        ;; C-u and that 1 exits isearch whereas it doesn't
-                        ;; exit C-u.
-                        t)
-                       ((null keep-pred) nil)
-                       ((eq t keep-pred)
-                        (eq this-command
-                            (lookup-key map (this-command-keys-vector))))
-                       (t (funcall keep-pred)))
-                (internal-pop-keymap map 'overriding-terminal-local-map)
-                (remove-hook 'pre-command-hook clearfun)
-                (when on-exit (funcall on-exit))))))
+          (suspicious-object
+           (lambda ()
+             (with-demoted-errors "set-transient-map PCH: %S"
+               (unless (cond
+                         ((not (eq map (cadr overriding-terminal-local-map)))
+                          ;; There's presumably some other transient-map in
+                          ;; effect.  Wait for that one to terminate before we
+                          ;; remove ourselves.
+                          ;; For example, if isearch and C-u both use transient
+                          ;; maps, then the lifetime of the C-u should be nested
+                          ;; within isearch's, so the pre-command-hook of
+                          ;; isearch should be suspended during the C-u one so
+                          ;; we don't exit isearch just because we hit 1 after
+                          ;; C-u and that 1 exits isearch whereas it doesn't
+                          ;; exit C-u.
+                          t)
+                         ((null keep-pred) nil)
+                         ((eq t keep-pred)
+                          (eq this-command
+                              (lookup-key map (this-command-keys-vector))))
+                         (t (funcall keep-pred)))
+                 (internal-pop-keymap map 'overriding-terminal-local-map)
+                 (remove-hook 'pre-command-hook clearfun)
+                 (when on-exit (funcall on-exit))
+                 ;; Comment out the fset if you want to debug the GC bug.
+;;;            (fset clearfun nil)
+;;;             (set clearfun nil)
+                 )))))
     (add-hook 'pre-command-hook clearfun)
     (internal-push-keymap map 'overriding-terminal-local-map)))