X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d4aa48db8ed36b1fc7e7b0e6bd35049353f7f96e..a971635315e259c076de020b3676c04d1dcc415e:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0643b85672..d251ab0e34 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,17 +1,17 @@ ;;; help-fns.el --- Complex help functions ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -151,9 +149,11 @@ KIND should be `var' for a variable or `subr' for a subroutine." (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) + (if (string-match "^ns.*\\(\\.o\\|obj\\)\\'" file) + (setq file (replace-match ".m" t t file 1)) + (if (string-match "\\.\\(o\\|obj\\)\\'" file) + (setq file (replace-match ".c" t t file)))) + (if (string-match "\\.\\(c\\|m\\)\\'" file) (concat "src/" file) file))))) @@ -248,11 +248,12 @@ face (according to `face-differs-from-default-p')." src-file file-name))) -(declare-function ad-get-advice-info "emacs-lisp/advice" (function)) +(declare-function ad-get-advice-info "advice" (function)) ;;;###autoload (defun describe-function-1 (function) - (let* ((advised (and (featurep 'advice) (ad-get-advice-info function))) + (let* ((advised (and (symbolp function) (featurep 'advice) + (ad-get-advice-info function))) ;; If the function is advised, use the symbol that has the ;; real definition, if that symbol is already set up. (real-function @@ -266,7 +267,8 @@ face (according to `face-differs-from-default-p')." (symbol-function real-function) function)) file-name string - (beg (if (commandp def) "an interactive " "a "))) + (beg (if (commandp def) "an interactive " "a ")) + (pt1 (with-current-buffer (help-buffer) (point)))) (setq string (cond ((or (stringp def) (vectorp def)) @@ -347,8 +349,12 @@ face (according to `face-differs-from-default-p')." (re-search-backward "`\\([^`']+\\)'" nil t) (help-xref-button 1 'help-function-def real-function file-name)))) (princ ".") - (terpri) + (with-current-buffer (help-buffer) + (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) + (point))) + (terpri)(terpri) (when (commandp function) + (let ((pt2 (with-current-buffer (help-buffer) (point)))) (if (and (eq function 'self-insert-command) (eq (key-binding "a") 'self-insert-command) (eq (key-binding "b") 'self-insert-command) @@ -368,7 +374,7 @@ face (according to `face-differs-from-default-p')." (princ "'")) (when keys - (princ (if remapped " which is bound to " "It is bound to ")) + (princ (if remapped ", which is bound to " "It is bound to ")) ;; If lots of ordinary text characters run this command, ;; don't mention them one by one. (if (< (length non-modified-keys) 10) @@ -382,13 +388,15 @@ face (according to `face-differs-from-default-p')." (princ "many ordinary text characters")))) (when (or remapped keys non-modified-keys) (princ ".") - (terpri))))) + (terpri)))) + (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 (point))) + (terpri))) (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) (with-current-buffer standard-output ;; If definition is a keymap, skip arglist note. - (unless (keymapp def) + (unless (keymapp function) (let* ((use (cond (usage (setq doc (cdr usage)) (car usage)) ((listp arglist) @@ -413,18 +421,19 @@ face (according to `face-differs-from-default-p')." (insert (car high) "\n") (fill-region fill-begin (point))) (setq doc (cdr high)))) - (let ((obsolete (and - ;; function might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info)))) + (let* ((obsolete (and + ;; function might be a lambda construct. + (symbolp function) + (get function 'byte-obsolete-info))) + (use (car obsolete))) (when obsolete (princ "\nThis function is obsolete") (when (nth 2 obsolete) (insert (format " since %s" (nth 2 obsolete)))) - (insert ";\n" - (if (stringp (car obsolete)) (car obsolete) - (format "use `%s' instead." (car obsolete))) - "\n")) + (insert (cond ((stringp use) (concat ";\n" use)) + (use (format ";\nuse `%s' instead." use)) + (t ".")) + "\n")) (insert "\n" (or doc "Not documented."))))))) @@ -436,8 +445,8 @@ face (according to `face-differs-from-default-p')." "Return the bound variable symbol found at or before point. 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 + (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () (save-excursion (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) @@ -445,17 +454,17 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (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)) + (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))) (defun describe-variable-custom-version-info (variable) (let ((custom-version (get variable 'custom-version)) @@ -467,7 +476,9 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." custom-version)) (when cpv (let* ((package (car-safe cpv)) - (version (car (cdr-safe cpv))) + (version (if (listp (cdr-safe cpv)) + (car (cdr-safe cpv)) + (cdr-safe cpv))) (pkg-versions (assq package customize-package-emacs-version-alist)) (emacsv (cdr (assoc version pkg-versions)))) (if (and package version) @@ -628,9 +639,10 @@ it is displayed along with the global value." (terpri) (let* ((alias (condition-case nil - (indirect-variable variable) - (error variable))) + (indirect-variable variable) + (error variable))) (obsolete (get variable 'byte-obsolete-variable)) + (use (car obsolete)) (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property variable 'variable-documentation) (documentation-property alias 'variable-documentation))) @@ -652,9 +664,9 @@ it is displayed along with the global value." (setq extra-line t) (princ " This variable is obsolete") (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) - (princ ";\n ") - (princ (if (stringp (car obsolete)) (car obsolete) - (format "use `%s' instead." (car obsolete)))) + (princ (cond ((stringp use) (concat ";\n " use)) + (use (format ";\n use `%s' instead." (car obsolete))) + (t "."))) (terpri)) (when safe-var (setq extra-line t) @@ -668,6 +680,7 @@ it is displayed along with the global value." (princ "Documentation:\n") (with-current-buffer standard-output (insert (or doc "Not documented as a variable.")))) + ;; Make a link to customize if this variable can be customized. (when (custom-variable-p variable) (let ((customize-label "customize"))