Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 243:f220cc83d72e r20-5b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b20
author cvs
date Mon, 13 Aug 2007 10:17:07 +0200
parents 41f2f0e326e9
children 83b3d10dcba9
comparison
equal deleted inserted replaced
242:fc816b73a05f 243:f220cc83d72e
59 (fset 'help-command help-map) 59 (fset 'help-command help-map)
60 60
61 (define-key help-map (vector help-char) 'help-for-help) 61 (define-key help-map (vector help-char) 'help-for-help)
62 (define-key help-map "?" 'help-for-help) 62 (define-key help-map "?" 'help-for-help)
63 (define-key help-map 'help 'help-for-help) 63 (define-key help-map 'help 'help-for-help)
64 (define-key help-map '(f1) 'help-for-help)
64 65
65 (define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs 66 (define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs
66 (define-key help-map "\C-d" 'describe-distribution) 67 (define-key help-map "\C-d" 'describe-distribution)
67 (define-key help-map "\C-w" 'describe-no-warranty) 68 (define-key help-map "\C-w" 'describe-no-warranty)
68 (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs 69 (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs
381 (gettext "%s runs the command %s")) 382 (gettext "%s runs the command %s"))
382 ;; This used to say 'This menu item' but it could also 383 ;; This used to say 'This menu item' but it could also
383 ;; be a scrollbar event. We can't distinguish at the 384 ;; be a scrollbar event. We can't distinguish at the
384 ;; moment. 385 ;; moment.
385 (if menup "This item" (key-description key)) 386 (if menup "This item" (key-description key))
386 (if (symbolp defn) defn (prin1-to-string defn))))))) 387 (format (if (symbolp defn) "`%s'" "%s") defn))))))
387 388
388 ;; #### this is a horrible piece of shit function that should 389 ;; #### this is a horrible piece of shit function that should
389 ;; not exist. In FSF 19.30 this function has gotten three times 390 ;; not exist. In FSF 19.30 this function has gotten three times
390 ;; as long and has tons and tons of dumb shit checking 391 ;; as long and has tons and tons of dumb shit checking
391 ;; special-display-buffer-names and such crap. I absolutely 392 ;; special-display-buffer-names and such crap. I absolutely
439 (help-not-visible 440 (help-not-visible
440 (not (and (windows-of-buffer buffer-name) ;shortcut 441 (not (and (windows-of-buffer buffer-name) ;shortcut
441 (member (selected-frame) 442 (member (selected-frame)
442 (mapcar 'window-frame 443 (mapcar 'window-frame
443 (windows-of-buffer buffer-name))))))) 444 (windows-of-buffer buffer-name)))))))
445 (if (get-buffer buffer-name)
446 (kill-buffer buffer-name))
444 (prog1 (with-output-to-temp-buffer buffer-name 447 (prog1 (with-output-to-temp-buffer buffer-name
445 (prog1 ,@body 448 (prog1 ,@body
446 (save-excursion 449 (save-excursion
447 (set-buffer standard-output) 450 (set-buffer standard-output)
448 (help-mode)))) 451 (help-mode))))
478 (if (or (null defn) (integerp defn)) 481 (if (or (null defn) (integerp defn))
479 (message "%s is undefined" key-string) 482 (message "%s is undefined" key-string)
480 (with-displaying-help-buffer (format "key `%s'" key-string) 483 (with-displaying-help-buffer (format "key `%s'" key-string)
481 (princ key-string) 484 (princ key-string)
482 (princ " runs ") 485 (princ " runs ")
483 (if (symbolp defn) (princ (format "`%S'" defn)) 486 (if (symbolp defn)
484 (prin1 defn)) 487 (princ (format "`%s'" defn))
488 (princ defn))
485 (princ "\n\n") 489 (princ "\n\n")
486 (cond ((or (stringp defn) (vectorp defn)) 490 (cond ((or (stringp defn) (vectorp defn))
487 (let ((cmd (key-binding defn))) 491 (let ((cmd (key-binding defn)))
488 (if (not cmd) 492 (if (not cmd)
489 (princ "a keyboard macro") 493 (princ "a keyboard macro")
490 (progn 494 (progn
491 (princ "a keyboard macro which runs the command ") 495 (princ "a keyboard macro which runs the command ")
492 (prin1 cmd) 496 (princ cmd)
493 (princ ":\n\n") 497 (princ ":\n\n")
494 (if (documentation cmd) (princ (documentation cmd))))))) 498 (if (documentation cmd) (princ (documentation cmd)))))))
495 ((and (consp defn) (not (eq 'lambda (car-safe defn)))) 499 ((and (consp defn) (not (eq 'lambda (car-safe defn))))
496 (let ((describe-function-show-arglist nil)) 500 (let ((describe-function-show-arglist nil))
497 (describe-function-1 (car defn)))) 501 (describe-function-1 (car defn))))
922 (function-arglist 'function-arglist) 926 (function-arglist 'function-arglist)
923 => (function-arglist FUNCTION) 927 => (function-arglist FUNCTION)
924 928
925 This function is used by `describe-function-1' to list function 929 This function is used by `describe-function-1' to list function
926 arguments in the standard Lisp style." 930 arguments in the standard Lisp style."
927 (let* ((fndef (symbol-function function)) 931 (let* ((fndef (indirect-function function))
928 (arglist 932 (arglist
929 (cond ((compiled-function-p fndef) 933 (cond ((compiled-function-p fndef)
930 (compiled-function-arglist fndef)) 934 (compiled-function-arglist fndef))
931 ((eq (car-safe fndef) 'lambda) 935 ((eq (car-safe fndef) 'lambda)
932 (nth 1 fndef)) 936 (nth 1 fndef))
960 (setq doc (substring doc 0 (match-beginning 0)))) 964 (setq doc (substring doc 0 (match-beginning 0))))
961 doc)) 965 doc))
962 966
963 (defun describe-function-1 (function &optional nodoc) 967 (defun describe-function-1 (function &optional nodoc)
964 "This function does the work for `describe-function'." 968 "This function does the work for `describe-function'."
965 (princ (format "`%S' is " function)) 969 (princ (format "`%s' is " function))
966 (let* ((def function) 970 (let* ((def function)
967 aliases file-name autoload-file kbd-macro-p fndef macrop) 971 aliases file-name autoload-file kbd-macro-p fndef macrop)
968 (while (and (symbolp def) (fboundp def)) 972 (while (and (symbolp def) (fboundp def))
969 (when (not (eq def function)) 973 (when (not (eq def function))
970 (setq aliases 974 (setq aliases
1002 (setq kbd-macro-p t)) 1006 (setq kbd-macro-p t))
1003 ((subrp fndef) 1007 ((subrp fndef)
1004 (funcall int "built-in" nil macrop)) 1008 (funcall int "built-in" nil macrop))
1005 ((compiled-function-p fndef) 1009 ((compiled-function-p fndef)
1006 (funcall int "compiled Lisp" nil macrop)) 1010 (funcall int "compiled Lisp" nil macrop))
1007 ; XEmacs -- we handle aliases above.
1008 ; ((symbolp fndef)
1009 ; (princ (format "alias for `%s'"
1010 ; (prin1-to-string def))))
1011 ((eq (car-safe fndef) 'lambda) 1011 ((eq (car-safe fndef) 'lambda)
1012 (funcall int "Lisp" nil macrop)) 1012 (funcall int "Lisp" nil macrop))
1013 ((eq (car-safe fndef) 'mocklisp) 1013 ((eq (car-safe fndef) 'mocklisp)
1014 (funcall int "mocklisp" nil macrop)) 1014 (funcall int "mocklisp" nil macrop))
1015 ((eq (car-safe def) 'autoload) 1015 ((eq (car-safe def) 'autoload)
1035 (terpri) 1035 (terpri)
1036 (cond (kbd-macro-p 1036 (cond (kbd-macro-p
1037 (princ "These characters are executed:\n\n\t") 1037 (princ "These characters are executed:\n\n\t")
1038 (princ (key-description def)) 1038 (princ (key-description def))
1039 (cond ((setq def (key-binding def)) 1039 (cond ((setq def (key-binding def))
1040 (princ (format "\n\nwhich executes the command %S.\n\n" def)) 1040 (princ (format "\n\nwhich executes the command `%s'.\n\n"
1041 def))
1041 (describe-function-1 def)))) 1042 (describe-function-1 def))))
1042 (nodoc nil) 1043 (nodoc nil)
1043 (t 1044 (t
1044 ;; tell the user about obsoleteness. 1045 ;; tell the user about obsoleteness.
1045 ;; If the function is obsolete and is aliased, don't 1046 ;; If the function is obsolete and is aliased, don't
1130 (default-console "a built-in default console-local variable") 1131 (default-console "a built-in default console-local variable")
1131 (t 1132 (t
1132 (if type "an unknown type of built-in variable?" 1133 (if type "an unknown type of built-in variable?"
1133 "a variable declared in Lisp"))))) 1134 "a variable declared in Lisp")))))
1134 1135
1135 (defun help-pretty-print-value (object) 1136 (defcustom help-pretty-print-limit 100
1136 "Print OBJECT in current buffer. 1137 "Limit on length of lists above which pretty-printing of values is stopped.
1137 Use `pp-internal' if defined, otherwise `cl-prettyprint'" 1138 Setting this to 0 disables pretty-printing."
1139 :type 'integer
1140 :group 'help)
1141
1142 (defun help-maybe-pretty-print-value (object)
1143 "Pretty-print OBJECT, unless it is a long list.
1144 OBJECT is printed in the current buffer. Unless it is a list with
1145 more than `help-pretty-print-limit' elements, it is pretty-printed.
1146
1147 Uses `pp-internal' if defined, otherwise `cl-prettyprint'"
1138 (princ 1148 (princ
1139 (with-output-to-string 1149 (if (and (or (listp object) (vectorp object))
1140 (with-syntax-table emacs-lisp-mode-syntax-table 1150 (< (length object)
1141 ;; print `#<...>' values better 1151 help-pretty-print-limit))
1142 (modify-syntax-entry ?< "(>") 1152 (with-output-to-string
1143 (modify-syntax-entry ?> ")<") 1153 (with-syntax-table emacs-lisp-mode-syntax-table
1144 (let ((indent-line-function 'lisp-indent-line)) 1154 ;; print `#<...>' values better
1145 (if (fboundp 'pp-internal) 1155 (modify-syntax-entry ?< "(>")
1146 (progn 1156 (modify-syntax-entry ?> ")<")
1147 (pp-internal object "\n") 1157 (let ((indent-line-function 'lisp-indent-line))
1148 (terpri)) 1158 (if (fboundp 'pp-internal)
1149 (cl-prettyprint object))))))) 1159 (progn
1160 (pp-internal object "\n")
1161 (terpri))
1162 (cl-prettyprint object)))))
1163 (format "\n%s\n" object))))
1150 1164
1151 (defun describe-variable (variable) 1165 (defun describe-variable (variable)
1152 "Display the full documentation of VARIABLE (a symbol)." 1166 "Display the full documentation of VARIABLE (a symbol)."
1153 (interactive 1167 (interactive
1154 (let* ((v (variable-at-point)) 1168 (let* ((v (variable-at-point))
1184 (if file-name 1198 (if file-name
1185 (princ (format " -- loaded from \"%s\"\n" file-name)))) 1199 (princ (format " -- loaded from \"%s\"\n" file-name))))
1186 (princ "\nValue: ") 1200 (princ "\nValue: ")
1187 (if (not (boundp variable)) 1201 (if (not (boundp variable))
1188 (princ "void\n") 1202 (princ "void\n")
1189 (help-pretty-print-value (symbol-value variable))) 1203 (help-maybe-pretty-print-value (symbol-value variable)))
1190 (terpri) 1204 (terpri)
1191 (cond ((local-variable-p variable (current-buffer)) 1205 (cond ((local-variable-p variable (current-buffer))
1192 (let* ((void (cons nil nil)) 1206 (let* ((void (cons nil nil))
1193 (def (condition-case nil 1207 (def (condition-case nil
1194 (default-value variable) 1208 (default-value variable)
1202 (not (eq (symbol-value variable) def))) 1216 (not (eq (symbol-value variable) def)))
1203 ;; #### I18N3 doesn't localize properly! 1217 ;; #### I18N3 doesn't localize properly!
1204 (progn (princ "Default-value: ") 1218 (progn (princ "Default-value: ")
1205 (if (eq def void) 1219 (if (eq def void)
1206 (princ "void\n") 1220 (princ "void\n")
1207 (help-pretty-print-value def)) 1221 (help-maybe-pretty-print-value def))
1208 (terpri))))) 1222 (terpri)))))
1209 ((local-variable-p variable (current-buffer) t) 1223 ((local-variable-p variable (current-buffer) t)
1210 (princ "Setting it would make its value buffer-local.\n\n")))) 1224 (princ "Setting it would make its value buffer-local.\n\n"))))
1211 (princ "Documentation:") 1225 (princ "Documentation:")
1212 (terpri) 1226 (terpri)