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"))))