Mercurial > hg > xemacs-beta
diff lisp/help.el @ 243:f220cc83d72e r20-5b20
Import from CVS: tag r20-5b20
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:17:07 +0200 |
parents | 41f2f0e326e9 |
children | 83b3d10dcba9 |
line wrap: on
line diff
--- a/lisp/help.el Mon Aug 13 10:16:17 2007 +0200 +++ b/lisp/help.el Mon Aug 13 10:17:07 2007 +0200 @@ -61,6 +61,7 @@ (define-key help-map (vector help-char) 'help-for-help) (define-key help-map "?" 'help-for-help) (define-key help-map 'help 'help-for-help) +(define-key help-map '(f1) 'help-for-help) (define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs (define-key help-map "\C-d" 'describe-distribution) @@ -383,7 +384,7 @@ ;; be a scrollbar event. We can't distinguish at the ;; moment. (if menup "This item" (key-description key)) - (if (symbolp defn) defn (prin1-to-string defn))))))) + (format (if (symbolp defn) "`%s'" "%s") defn)))))) ;; #### this is a horrible piece of shit function that should ;; not exist. In FSF 19.30 this function has gotten three times @@ -441,6 +442,8 @@ (member (selected-frame) (mapcar 'window-frame (windows-of-buffer buffer-name))))))) + (if (get-buffer buffer-name) + (kill-buffer buffer-name)) (prog1 (with-output-to-temp-buffer buffer-name (prog1 ,@body (save-excursion @@ -480,8 +483,9 @@ (with-displaying-help-buffer (format "key `%s'" key-string) (princ key-string) (princ " runs ") - (if (symbolp defn) (princ (format "`%S'" defn)) - (prin1 defn)) + (if (symbolp defn) + (princ (format "`%s'" defn)) + (princ defn)) (princ "\n\n") (cond ((or (stringp defn) (vectorp defn)) (let ((cmd (key-binding defn))) @@ -489,7 +493,7 @@ (princ "a keyboard macro") (progn (princ "a keyboard macro which runs the command ") - (prin1 cmd) + (princ cmd) (princ ":\n\n") (if (documentation cmd) (princ (documentation cmd))))))) ((and (consp defn) (not (eq 'lambda (car-safe defn)))) @@ -924,7 +928,7 @@ This function is used by `describe-function-1' to list function arguments in the standard Lisp style." - (let* ((fndef (symbol-function function)) + (let* ((fndef (indirect-function function)) (arglist (cond ((compiled-function-p fndef) (compiled-function-arglist fndef)) @@ -962,7 +966,7 @@ (defun describe-function-1 (function &optional nodoc) "This function does the work for `describe-function'." - (princ (format "`%S' is " function)) + (princ (format "`%s' is " function)) (let* ((def function) aliases file-name autoload-file kbd-macro-p fndef macrop) (while (and (symbolp def) (fboundp def)) @@ -1004,10 +1008,6 @@ (funcall int "built-in" nil macrop)) ((compiled-function-p fndef) (funcall int "compiled Lisp" nil macrop)) -; XEmacs -- we handle aliases above. -; ((symbolp fndef) -; (princ (format "alias for `%s'" -; (prin1-to-string def)))) ((eq (car-safe fndef) 'lambda) (funcall int "Lisp" nil macrop)) ((eq (car-safe fndef) 'mocklisp) @@ -1037,7 +1037,8 @@ (princ "These characters are executed:\n\n\t") (princ (key-description def)) (cond ((setq def (key-binding def)) - (princ (format "\n\nwhich executes the command %S.\n\n" def)) + (princ (format "\n\nwhich executes the command `%s'.\n\n" + def)) (describe-function-1 def)))) (nodoc nil) (t @@ -1132,21 +1133,34 @@ (if type "an unknown type of built-in variable?" "a variable declared in Lisp"))))) -(defun help-pretty-print-value (object) - "Print OBJECT in current buffer. -Use `pp-internal' if defined, otherwise `cl-prettyprint'" +(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 - (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))))))) + (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)))) (defun describe-variable (variable) "Display the full documentation of VARIABLE (a symbol)." @@ -1186,7 +1200,7 @@ (princ "\nValue: ") (if (not (boundp variable)) (princ "void\n") - (help-pretty-print-value (symbol-value variable))) + (help-maybe-pretty-print-value (symbol-value variable))) (terpri) (cond ((local-variable-p variable (current-buffer)) (let* ((void (cons nil nil)) @@ -1204,7 +1218,7 @@ (progn (princ "Default-value: ") (if (eq def void) (princ "void\n") - (help-pretty-print-value def)) + (help-maybe-pretty-print-value def)) (terpri))))) ((local-variable-p variable (current-buffer) t) (princ "Setting it would make its value buffer-local.\n\n"))))