]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
Change encoding to iso-2022-7bit and add coding: tag.
[gnu-emacs] / lisp / help-fns.el
index e006a7f471412f1e5ca07d82280c2b77d03b2fba..4bf0a4775a083f65798352345fb3a40ca833d655 100644 (file)
@@ -97,6 +97,7 @@ With ARG, you are asked to choose which language."
          (forward-line 1)
          (newline (- n (/ n 2)))))
       (goto-char (point-min))
+      (setq buffer-undo-list nil)
       (set-buffer-modified-p nil))))
 
 ;;;###autoload
@@ -181,14 +182,14 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
   (unless (stringp docstring) (setq docstring "Not documented"))
   (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t))
       docstring
-    (format "%s%s%S" docstring
+    (concat docstring
            (if (string-match "\n?\n\\'" docstring)
                (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
              "\n\n")
            (if (and (stringp arglist)
                     (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
                (concat "(fn" (match-string 1 arglist) ")")
-             (help-make-usage 'fn arglist)))))
+             (format "%S" (help-make-usage 'fn arglist))))))
 
 (defun help-function-arglist (def)
   ;; Handle symbols aliased to other symbols.
@@ -216,6 +217,14 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
                        (intern (upcase name))))))
                arglist)))
 
+;;; Could be this, if we make symbol-file do the work below.
+;;; (defun help-C-file-name (subr-or-var kind)
+;;;   "Return the name of the C file where SUBR-OR-VAR is defined.
+;;; KIND should be `var' for a variable or `subr' for a subroutine."
+;;;   (symbol-file (if (symbolp subr-or-var) subr-or-var
+;;;             (subr-name subr-or-var))
+;;;           (if (eq kind 'var) 'defvar 'defun)))
+
 (defun help-C-file-name (subr-or-var kind)
   "Return the name of the C file where SUBR-OR-VAR is defined.
 KIND should be `var' for a variable or `subr' for a subroutine."
@@ -228,25 +237,34 @@ KIND should be `var' for a variable or `subr' for a subroutine."
       (if (eobp)
          (insert-file-contents-literally
           (expand-file-name internal-doc-file-name doc-directory)))
-      (search-forward (concat "\1f" name "\n"))
-      (re-search-backward "\1fS\\(.*\\)")
-      (let ((file (match-string 1)))
+      (let ((file (catch 'loop
+                   (while t
+                     (let ((pnt (search-forward (concat "\1f" name "\n"))))
+                       (re-search-backward "\1fS\\(.*\\)")
+                       (let ((file (match-string 1)))
+                         (if (member file build-files)
+                             (throw 'loop file)
+                           (goto-char pnt))))))))
        (if (string-match "\\.\\(o\\|obj\\)\\'" file)
            (setq file (replace-match ".c" t t file)))
        (if (string-match "\\.c\\'" file)
            (concat "src/" file)
          file)))))
 
-(defface help-argument-name '((t (:slant italic)))
-  "Face to highlight function arguments in *Help* buffers.
-You can customize this face.  For more extensive customization,
-see variable `help-arg-highlighting-function'.")
-
-(defvar help-arg-highlighting-function
-  #'(lambda (arg) (propertize (downcase arg) 'face 'help-argument-name))
-  "Function to call to highlight function arguments in *Help* buffers.
-The function receives the argument to highlight, as a string.
-It must return the string with the desired highlighting (properties).")
+;;;###autoload
+(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+  "Face to highlight argument names in *Help* buffers."
+  :group 'help)
+
+(defun help-default-arg-highlight (arg)
+  "Default function to highlight arguments in *Help* buffers.
+It returns ARG in face `help-argument-name'; ARG is also
+downcased if it displays differently than the default
+face (according to `face-differs-from-default-p')."
+  (propertize (if (face-differs-from-default-p 'help-argument-name)
+                  (downcase arg)
+                arg)
+              'face 'help-argument-name))
 
 (defun help-do-arg-highlight (doc args)
   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
@@ -264,7 +282,7 @@ It must return the string with the desired highlighting (properties).")
                            "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
                            "\\(?:-[a-z-]+\\)?"     ; for ARG-xxx
                            "\\>")                  ; end of word
-                   (funcall help-arg-highlighting-function arg)
+                   (help-default-arg-highlight arg)
                    doc t t 1))))
     doc))
 
@@ -277,6 +295,7 @@ It must return the string with the desired highlighting (properties).")
             (next (not (or args (looking-at "\\["))))
             (opt nil))
         ;; Make a list of all arguments
+        (skip-chars-forward "^ ")
         (while next
           (or opt (not (looking-at " &")) (setq opt t))
           (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
@@ -345,7 +364,7 @@ It must return the string with the desired highlighting (properties).")
          (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
              (help-xref-button 1 'help-function def)))))
     (or file-name
-       (setq file-name (symbol-file function)))
+       (setq file-name (symbol-file function 'defun)))
     (when (equal file-name "loaddefs.el")
       ;; Find the real def site of the preloaded function.
       ;; This is necessary only for defaliases.
@@ -453,21 +472,30 @@ It must return the string with the desired highlighting (properties).")
 ;; Variables
 
 ;;;###autoload
-(defun variable-at-point ()
+(defun variable-at-point (&optional any-symbol)
   "Return the bound variable symbol found around point.
-Return 0 if there is no such symbol."
-  (condition-case ()
-      (with-syntax-table emacs-lisp-mode-syntax-table
-       (save-excursion
-         (or (not (zerop (skip-syntax-backward "_w")))
-             (eq (char-syntax (following-char)) ?w)
-             (eq (char-syntax (following-char)) ?_)
-             (forward-sexp -1))
-         (skip-chars-forward "'")
-         (let ((obj (read (current-buffer))))
-           (or (and (symbolp obj) (boundp obj) obj)
-               0))))
-    (error 0)))
+Return 0 if there is no such symbol.
+If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
+  (or (condition-case ()
+         (with-syntax-table emacs-lisp-mode-syntax-table
+           (save-excursion
+             (or (not (zerop (skip-syntax-backward "_w")))
+                 (eq (char-syntax (following-char)) ?w)
+                 (eq (char-syntax (following-char)) ?_)
+                 (forward-sexp -1))
+             (skip-chars-forward "'")
+             (let ((obj (read (current-buffer))))
+               (and (symbolp obj) (boundp obj) obj))))
+       (error nil))
+      (let* ((str (find-tag-default))
+            (sym (if str (intern-soft str))))
+       (if (and sym (or any-symbol (boundp sym)))
+           sym
+         (save-match-data
+           (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
+             (setq sym (intern-soft (match-string 1 str)))
+             (and (or any-symbol (boundp sym)) sym)))))
+      0))
 
 ;;;###autoload
 (defun describe-variable (variable &optional buffer)
@@ -544,9 +572,16 @@ it is displayed along with the global value."
                    (forward-line 1)
                  (forward-sexp 1)
                  (delete-region (point) (progn (end-of-line) (point)))
-                 (insert " value is shown below.\n\n")
                  (save-excursion
-                   (insert "\n\nValue:"))))
+                   (insert "\n\nValue:")
+                   (set (make-local-variable 'help-button-cache)
+                        (point-marker)))
+                 (insert " value is shown ")
+                 (insert-button "below"
+                                'action help-button-cache
+                                'follow-link t
+                                'help-echo "mouse-2, RET: show value")
+                 (insert ".\n\n")))
              ;; Add a note for variables that have been make-var-buffer-local.
              (when (and (local-variable-if-set-p variable)
                         (or (not (local-variable-p variable))
@@ -589,7 +624,7 @@ it is displayed along with the global value."
            ;; Make a hyperlink to the library if appropriate.  (Don't
            ;; change the format of the buffer's initial line in case
            ;; anything expects the current format.)
-           (let ((file-name (symbol-file (cons 'defvar variable))))
+           (let ((file-name (symbol-file variable 'defvar)))
              (when (equal file-name "loaddefs.el")
                ;; Find the real def site of the preloaded variable.
                (let ((location