Mercurial > hg > xemacs-beta
diff lisp/help.el @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | 405dd6d1825b |
children | 90d73dddcdc4 |
line wrap: on
line diff
--- a/lisp/help.el Mon Aug 13 10:27:41 2007 +0200 +++ b/lisp/help.el Mon Aug 13 10:28:48 2007 +0200 @@ -18,14 +18,14 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Synched up with: FSF 19.30. ;;; Commentary: - + ;; This file is dumped with XEmacs. ;; This code implements XEmacs's on-line help system, the one invoked by @@ -151,7 +151,7 @@ ; become hyperlinks. ; -- we should *not* use font-lock keywords like below. Instead we ; should add the font-lock stuff ourselves during the scanning phase, -; if font-lock is enabled in this buffer. +; if font-lock is enabled in this buffer. ;(defun help-follow-reference (event extent user-data) ; (let ((symbol (intern-soft (extent-string extent)))) @@ -242,12 +242,12 @@ (search-backward-regexp "^\\w+:" nil t)) (defun help-mode-bury () - "Buries the buffer, possibly restoring the previous window configuration." + "Bury the help buffer, possibly restoring the previous window configuration." (interactive) (help-mode-quit t)) (defun help-mode-quit (&optional bury) - "Exits from help mode, possibly restoring the previous window configuration. + "Exit from help mode, possibly restoring the previous window configuration. If the optional argument BURY is non-nil, the help buffer is buried, otherwise it is killed." (interactive) @@ -366,7 +366,7 @@ "Print the name of the function KEY invokes. KEY is a string." (interactive "kDescribe key briefly: ") (let (defn menup) - (setq defn (key-or-menu-binding key 'menup)) + (setq defn (key-or-menu-binding key 'menup)) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) ;; If it's a keyboard macro which trivially invokes another command, @@ -634,8 +634,10 @@ If the second argument (prefix arg, interactively) is non-null then only the mouse bindings are displayed." (interactive (list nil current-prefix-arg)) - (with-displaying-help-buffer (format "bindings for %s" major-mode) - (describe-bindings-1 prefix mouse-only-p))) + (let (buf) + (with-displaying-help-buffer (format "bindings for %s" major-mode) + (setq buf (describe-bindings-1 prefix mouse-only-p))) + buf)) (defun describe-bindings-1 (&optional prefix mouse-only-p) (let ((heading (if mouse-only-p @@ -671,7 +673,8 @@ (insert "\nFunction key map translations:\n" heading) (describe-bindings-internal function-key-map nil nil prefix mouse-only-p)) - (set-buffer buffer))) + (set-buffer buffer) + standard-output)) (defun describe-prefix-bindings () "Describe the bindings of the prefix used to reach this command. @@ -691,7 +694,7 @@ (princ ":\n\n") (describe-bindings-1 prefix nil)))) -;; Make C-h after a prefix, when not specifically bound, +;; Make C-h after a prefix, when not specifically bound, ;; run describe-prefix-bindings. (setq prefix-help-command 'describe-prefix-bindings) @@ -967,7 +970,7 @@ ;; taken out of `describe-function-1' (defun function-arglist (function) - "Returns a string giving the argument list of FUNCTION. + "Return a string giving the argument list of FUNCTION. For example: (function-arglist 'function-arglist) @@ -999,8 +1002,8 @@ (format "(%s %s)" function arglist))))) (defun function-documentation (function &optional strip-arglist) - "Returns a string giving the documentation for FUNCTION if any. -If the optional argument STRIP-ARGLIST is non-nil remove the arglist + "Return a string giving the documentation for FUNCTION, if any. +If the optional argument STRIP-ARGLIST is non-nil, remove the arglist part of the documentation of internal subroutines." (let ((doc (condition-case nil (or (documentation function) @@ -1021,7 +1024,7 @@ (setq aliases (if aliases ;; I18N3 Need gettext due to concat - (concat aliases + (concat aliases (format "\n which is an alias for `%s', " (symbol-name def))) @@ -1180,43 +1183,9 @@ (if type "an unknown type of built-in variable?" "a variable declared in Lisp"))))) -(defcustom help-pretty-print-limit 100 - "Limit on length of lists above which pretty-printing of values is stopped. -Setting this to 0 disables pretty-printing." - :type 'integer - :group 'help) - -(defun help-maybe-pretty-print-value (object) - "Pretty-print OBJECT, unless it is a long list. -OBJECT is printed in the current buffer. Unless it is a list with -more than `help-pretty-print-limit' elements, it is pretty-printed. - -Uses `pp-internal' if defined, otherwise `cl-prettyprint'" - (princ - (let ((valstr - (if (and (or (listp object) (vectorp object)) - (< (length object) - help-pretty-print-limit)) - (with-output-to-string - (with-syntax-table emacs-lisp-mode-syntax-table - ;; print `#<...>' values better - (modify-syntax-entry ?< "(>") - (modify-syntax-entry ?> ")<") - (let ((indent-line-function 'lisp-indent-line)) - (if (fboundp 'pp-internal) - (progn - (pp-internal object "\n") - (terpri)) - (cl-prettyprint object))))) - (format "\n%S\n" object)))) - - (if (string-match "^\n[^\n]*\n$" valstr) - (substring valstr 1) - valstr)))) - (defun describe-variable (variable) "Display the full documentation of VARIABLE (a symbol)." - (interactive + (interactive (let* ((v (variable-at-point)) (val (let ((enable-recursive-minibuffers t)) (completing-read @@ -1235,7 +1204,7 @@ (if aliases ;; I18N3 Need gettext due to concat (setq aliases - (concat aliases + (concat aliases (format "\n which is an alias for `%s'," (symbol-name newvar)))) (setq aliases @@ -1252,7 +1221,8 @@ (princ "\nValue: ") (if (not (boundp variable)) (princ "void\n") - (help-maybe-pretty-print-value (symbol-value variable))) + (prin1 (symbol-value variable)) + (terpri)) (terpri) (cond ((local-variable-p variable (current-buffer)) (let* ((void (cons nil nil)) @@ -1270,7 +1240,8 @@ (progn (princ "Default-value: ") (if (eq def void) (princ "void\n") - (help-maybe-pretty-print-value def)) + (prin1 def) + (terpri)) (terpri))))) ((local-variable-p variable (current-buffer) t) (princ "Setting it would make its value buffer-local.\n\n")))) @@ -1311,7 +1282,7 @@ `function-at-point'." (interactive (let ((fn (function-at-point)) - (enable-recursive-minibuffers t) + (enable-recursive-minibuffers t) val) (setq val (read-command (if fn (format "Where is command (default %s): " fn)