Fix infloop on MS-Windows when initial frame lacks minibuffer.
[bpt/emacs.git] / lisp / help-fns.el
index 5791f12..52aa051 100644 (file)
@@ -1,7 +1,7 @@
 ;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2012
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2013 Free Software
+;; Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
@@ -76,7 +76,7 @@ DEF is the function whose usage we're looking for in DOCSTRING."
   (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
     (cons (format "(%s%s"
                  ;; Replace `fn' with the actual function name.
-                 (if (consp def) "anonymous" def)
+                 (if (symbolp def) def "anonymous")
                  (match-string 1 docstring))
          (unless (zerop (match-beginning 0))
             (substring docstring 0 (match-beginning 0))))))
@@ -336,11 +336,15 @@ suitable file is found, return nil."
       ;; If we don't have a file-name string by now, we lost.
       nil)
      ;; Now, `file-name' should have become an absolute file name.
-     ;; For files loaded from ~/.emacs.elc, try ~/.emacs.
+     ;; For files loaded from ~/.foo.elc, try ~/.foo.
+     ;; This applies to config files like ~/.emacs,
+     ;; which people sometimes compile.
      ((let (fn)
-       (and (string-equal file-name
-                          (expand-file-name ".emacs.elc" "~"))
-            (file-readable-p (setq fn (expand-file-name ".emacs" "~")))
+       (and (string-match "\\`\\..*\\.elc\\'"
+                          (file-name-nondirectory file-name))
+            (string-equal (file-name-directory file-name)
+                          (file-name-as-directory (expand-file-name "~")))
+            (file-readable-p (setq fn (file-name-sans-extension file-name)))
             fn)))
      ;; When the Elisp source file can be found in the install
      ;; directory, return the name of that file.
@@ -431,14 +435,19 @@ suitable file is found, return nil."
   (let ((handler (function-get function 'compiler-macro)))
     (when handler
       (insert "\nThis function has a compiler macro")
-      (let ((lib (get function 'compiler-macro-file)))
-        ;; FIXME: rather than look at the compiler-macro-file property,
-        ;; just look at `handler' itself.
-        (when (stringp lib)
-          (insert (format " in `%s'" lib))
-          (save-excursion
-            (re-search-backward "`\\([^`']+\\)'" nil t)
-            (help-xref-button 1 'help-function-cmacro function lib))))
+      (if (symbolp handler)
+          (progn
+            (insert (format " `%s'" handler))
+            (save-excursion
+              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function handler)))
+        ;; FIXME: Obsolete since 24.4.
+        (let ((lib (get function 'compiler-macro-file)))
+          (when (stringp lib)
+            (insert (format " in `%s'" lib))
+            (save-excursion
+              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function-cmacro function lib)))))
       (insert ".\n"))))
 
 (defun help-fns--signature (function doc real-def real-function)
@@ -488,13 +497,16 @@ suitable file is found, return nil."
       (insert "'.\n"))))
 
 (defun help-fns--obsolete (function)
-  (let* ((obsolete (and
-                    ;; `function' might be a lambda construct.
-                    (symbolp function)
-                    (get function 'byte-obsolete-info)))
+  ;; Ignore lambda constructs, keyboard macros, etc.
+  (let* ((obsolete (and (symbolp function)
+                       (get function 'byte-obsolete-info)))
          (use (car obsolete)))
     (when obsolete
-      (insert "\nThis function is obsolete")
+      (insert "\nThis "
+             (if (eq (car-safe (symbol-function function)) 'macro)
+                 "macro"
+               "function")
+             " is obsolete")
       (when (nth 2 obsolete)
         (insert (format " since %s" (nth 2 obsolete))))
       (insert (cond ((stringp use) (concat ";\n" use))
@@ -611,14 +623,12 @@ FILE is the file where FUNCTION was probably defined."
        (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
                                  (point)))
       (terpri)(terpri)
-      
-      (let* ((doc-raw (condition-case err
-                         (documentation function t)
-                       (error (format "No Doc! %S" err))))
+
+      (let* ((doc-raw (documentation function t))
             ;; If the function is autoloaded, and its docstring has
             ;; key substitution constructs, load the library.
             (doc (progn
-                   (and (autoloadp real-def)
+                   (and (autoloadp real-def) doc-raw
                         help-enable-auto-load
                         (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
                                       doc-raw)
@@ -788,7 +798,7 @@ it is displayed along with the global value."
              (cond
                ((bufferp locus)
                 (princ (format "Local in buffer %s; "
-                               (buffer-name))))
+                               (buffer-name buffer))))
                ((framep locus)
                 (princ (format "It is a frame-local variable; ")))
                ((terminal-live-p locus)
@@ -846,12 +856,10 @@ it is displayed along with the global value."
                    (obsolete (get variable 'byte-obsolete-variable))
                   (use (car obsolete))
                   (safe-var (get variable 'safe-local-variable))
-                   (doc (condition-case err
-                            (or (documentation-property
-                                 variable 'variable-documentation)
-                                (documentation-property
-                                 alias 'variable-documentation))
-                          (error (format "Doc not found: %S" err))))
+                   (doc (or (documentation-property
+                             variable 'variable-documentation)
+                            (documentation-property
+                             alias 'variable-documentation)))
                    (extra-line nil))
 
              ;; Mention if it's a local variable.
@@ -867,8 +875,10 @@ it is displayed along with the global value."
                (princ "buffer-local when set.\n"))
               ((not permanent-local))
               ((bufferp locus)
+               (setq extra-line t)
                (princ "  This variable's buffer-local value is permanent.\n"))
               (t
+               (setq extra-line t)
                 (princ "  This variable's value is permanent \
 if it is given a local binding.\n")))
 
@@ -936,7 +946,7 @@ file-local variable.\n")
                (princ "  This variable is safe as a file local variable ")
                (princ "if its value\n  satisfies the predicate ")
                (princ (if (byte-code-function-p safe-var)
-                          "which is byte-compiled expression.\n"
+                          "which is byte-compiled expression.\n"
                         (format "`%s'.\n" safe-var))))
 
               (if extra-line (terpri))