Mercurial > hg > xemacs-beta

comparison lisp/prim/help.el @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents e121b013d1f0
children f53b5ca2e663
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
409 (message "%s is undefined" (key-description key)) 409 (message "%s is undefined" (key-description key))
410 (with-displaying-help-buffer 410 (with-displaying-help-buffer
411 (lambda () 411 (lambda ()
412 (princ (key-description key)) 412 (princ (key-description key))
413 (princ " runs ") 413 (princ " runs ")
414 (princ (format "`%s'" defn)) 414 (if (symbolp defn) (princ (format "`%S'" defn))
415 (prin1 defn))
415 (princ "\n\n") 416 (princ "\n\n")
416 (cond ((or (stringp defn) (vectorp defn)) 417 (cond ((or (stringp defn) (vectorp defn))
417 (let ((cmd (key-binding defn))) 418 (let ((cmd (key-binding defn)))
418 (if (not cmd) 419 (if (not cmd)
419 (princ "a keyboard macro") 420 (princ "a keyboard macro")
420 (progn 421 (progn
421 (princ (format "a keyboard macro which runs the command %s:\n\n" 422 (princ "a keyboard macro which runs the command ")
422 cmd)) 423 (prin1 cmd)
423 (princ cmd) 424 (princ ":\n\n")
424 (princ "\n")
425 (if (documentation cmd) (princ (documentation cmd))))))) 425 (if (documentation cmd) (princ (documentation cmd)))))))
426 ((and (consp defn) (not (eq 'lambda (car-safe defn)))) 426 ((and (consp defn) (not (eq 'lambda (car-safe defn))))
427 (princ "\n")
428 (let ((describe-function-show-arglist nil)) 427 (let ((describe-function-show-arglist nil))
429 (describe-function-1 (car defn) standard-output))) 428 (describe-function-1 (car defn) standard-output)))
429 ((symbolp defn)
430 (describe-function-1 defn standard-output))
430 ((documentation defn) 431 ((documentation defn)
431 (princ (documentation defn))) 432 (princ (documentation defn)))
432 (t 433 (t
433 (princ "not documented")))))))) 434 (princ "not documented"))))))))
434 435
555 (insert "\n") 556 (insert "\n")
556 (setq shadow (cons local shadow)))) 557 (setq shadow (cons local shadow))))
557 (insert "Global Bindings:\n" heading) 558 (insert "Global Bindings:\n" heading)
558 (describe-bindings-internal (current-global-map) 559 (describe-bindings-internal (current-global-map)
559 nil shadow prefix mouse-only-p) 560 nil shadow prefix mouse-only-p)
561 (when (and prefix function-key-map (not mouse-only-p))
562 (insert "\nFunction key map translations:\n" heading)
563 (describe-bindings-internal function-key-map nil nil prefix mouse-only-p))
560 (set-buffer buffer))) 564 (set-buffer buffer)))
561 565
562 (defun describe-prefix-bindings () 566 (defun describe-prefix-bindings ()
563 "Describe the bindings of the prefix used to reach this command. 567 "Describe the bindings of the prefix used to reach this command.
564 The prefix described consists of all but the last event 568 The prefix described consists of all but the last event
858 862
859 (defun describe-function-1 (function stream &optional nodoc) 863 (defun describe-function-1 (function stream &optional nodoc)
860 (princ (format "`%S' is " function) stream) 864 (princ (format "`%S' is " function) stream)
861 (let* ((def function) 865 (let* ((def function)
862 file-name 866 file-name
863 (doc (or (documentation function) 867 (doc (condition-case nil
864 (gettext "not documented"))) 868 (or (documentation function)
869 (gettext "not documented"))
870 (void-function "")))
865 aliases home kbd-macro-p fndef macrop) 871 aliases home kbd-macro-p fndef macrop)
866 (while (symbolp def) 872 (while (and (symbolp def) (fboundp def))
867 (or (eq def function) 873 (when (not (eq def function))
868 (if aliases 874 (setq aliases
869 ;; I18N3 Need gettext due to concat 875 (if aliases
870 (setq aliases (concat aliases 876 ;; I18N3 Need gettext due to concat
871 (format 877 (concat aliases
872 "\n which is an alias for `%s', " 878 (format
873 (symbol-name def)))) 879 "\n which is an alias for `%s', "
874 (setq aliases (format "an alias for `%s', " 880 (symbol-name def)))
875 (symbol-name def))))) 881 (format "an alias for `%s', " (symbol-name def)))))
876 (setq def (symbol-function def))) 882 (setq def (symbol-function def)))
877 (if (compiled-function-p def) 883 (if (compiled-function-p def)
878 (setq home (compiled-function-annotation def))) 884 (setq home (compiled-function-annotation def)))
879 (if (eq 'macro (car-safe def)) 885 (if (eq 'macro (car-safe def))
880 (setq fndef (cdr def) 886 (setq fndef (cdr def)
908 ((eq (car-safe fndef) 'mocklisp) 914 ((eq (car-safe fndef) 'mocklisp)
909 (funcall int "mocklisp" nil macrop)) 915 (funcall int "mocklisp" nil macrop))
910 ((eq (car-safe def) 'autoload) 916 ((eq (car-safe def) 'autoload)
911 (setq file-name (elt def 1)) 917 (setq file-name (elt def 1))
912 (funcall int "autoloaded Lisp" t (elt def 4))) 918 (funcall int "autoloaded Lisp" t (elt def 4)))
919 ((and (symbolp def) (not (fboundp def)))
920 (princ "a symbol with a void (unbound) function definition." stream))
913 (t 921 (t
914 nil))) 922 nil)))
915 (princ "\n") 923 (princ "\n")
916 (or file-name 924 (or file-name
917 (setq file-name (describe-function-find-file function))) 925 (setq file-name (describe-function-find-file function)))
959 ;; If the function is obsolete and is aliased, don't 967 ;; If the function is obsolete and is aliased, don't
960 ;; even bother to report the documentation, as a further 968 ;; even bother to report the documentation, as a further
961 ;; encouragement to use the new function. 969 ;; encouragement to use the new function.
962 (let ((obsolete (function-obsoleteness-doc function)) 970 (let ((obsolete (function-obsoleteness-doc function))
963 (compatible (function-compatibility-doc function))) 971 (compatible (function-compatibility-doc function)))
964 (if obsolete 972 (when obsolete
965 (progn 973 (princ obsolete stream)
966 (princ obsolete stream) 974 (terpri stream)
967 (terpri stream) 975 (terpri stream))
968 (terpri stream))) 976 (when compatible
969 (if compatible 977 (princ compatible stream)
970 (progn 978 (terpri stream)
971 (princ compatible stream) 979 (terpri stream))
972 (terpri stream) 980 (unless (and obsolete aliases)
973 (terpri stream))) 981 (princ doc stream)
974 (if (not (and obsolete aliases)) 982 (unless (or (equal doc "")
975 (progn 983 (eq ?\n (aref doc (1- (length doc)))))
976 (princ doc stream) 984 (terpri stream))))))))
977 (or (equal doc "")
978 (eq ?\n (aref doc (1- (length doc))))
979 (terpri stream)))))))))
980 985
981 986
982 (defun describe-function-arglist (function) 987 (defun describe-function-arglist (function)
983 (interactive (list (or (function-called-at-point) 988 (interactive (list (or (function-called-at-point)
984 (error "no function call at point")))) 989 (error "no function call at point"))))
997 (message (buffer-substring (point-min) (point)))) 1002 (message (buffer-substring (point-min) (point))))
998 (and b (kill-buffer b))))) 1003 (and b (kill-buffer b)))))
999 1004
1000 1005
1001 (defun variable-at-point () 1006 (defun variable-at-point ()
1002 (condition-case () 1007 (ignore-errors
1003 (let ((stab (syntax-table))) 1008 (let ((stab (syntax-table)))
1004 (unwind-protect 1009 (unwind-protect
1005 (save-excursion 1010 (save-excursion
1006 (set-syntax-table emacs-lisp-mode-syntax-table) 1011 (set-syntax-table emacs-lisp-mode-syntax-table)
1007 (or (not (zerop (skip-syntax-backward "_w"))) 1012 (or (not (zerop (skip-syntax-backward "_w")))
1008 (eq (char-syntax (char-after (point))) ?w) 1013 (eq (char-syntax (char-after (point))) ?w)
1009 (eq (char-syntax (char-after (point))) ?_) 1014 (eq (char-syntax (char-after (point))) ?_)
1010 (forward-sexp -1)) 1015 (forward-sexp -1))
1011 (skip-chars-forward "'") 1016 (skip-chars-forward "'")
1012 (let ((obj (read (current-buffer)))) 1017 (let ((obj (read (current-buffer))))
1013 (and (symbolp obj) (boundp obj) obj))) 1018 (and (symbolp obj) (boundp obj) obj)))
1014 (set-syntax-table stab))) 1019 (set-syntax-table stab)))))
1015 (error nil)))
1016 1020
1017 (defun variable-obsolete-p (variable) 1021 (defun variable-obsolete-p (variable)
1018 "Return non-nil if VARIABLE is obsolete." 1022 "Return non-nil if VARIABLE is obsolete."
1019 (not (null (get variable 'byte-obsolete-variable)))) 1023 (not (null (get variable 'byte-obsolete-variable))))
1020 1024
1431 near point (selected by `find-function-function') and places point 1435 near point (selected by `find-function-function') and places point
1432 before the definition. 1436 before the definition.
1433 1437
1434 If the optional argument PATH is given, the library where FUNCTION is 1438 If the optional argument PATH is given, the library where FUNCTION is
1435 defined is searched in PATH instead of `load-path'" 1439 defined is searched in PATH instead of `load-path'"
1436 (interactive (ff-read-function)) 1440 (interactive (find-function-read-function))
1437 (let ((buffer-point (find-function-noselect function path))) 1441 (let ((buffer-point (find-function-noselect function path)))
1438 (if buffer-point 1442 (if buffer-point
1439 (progn 1443 (progn
1440 (switch-to-buffer (car buffer-point)) 1444 (switch-to-buffer (car buffer-point))
1441 (goto-char (cadr buffer-point)) 1445 (goto-char (cadr buffer-point))
1448 near point (selected by `find-function-function') and places point 1452 near point (selected by `find-function-function') and places point
1449 before the definition. 1453 before the definition.
1450 1454
1451 If the optional argument PATH is given, the library where FUNCTION is 1455 If the optional argument PATH is given, the library where FUNCTION is
1452 defined is searched in PATH instead of `load-path'" 1456 defined is searched in PATH instead of `load-path'"
1453 (interactive (ff-read-function)) 1457 (interactive (find-function-read-function))
1454 (let ((buffer-point (find-function-noselect function path))) 1458 (let ((buffer-point (find-function-noselect function path)))
1455 (if buffer-point 1459 (if buffer-point
1456 (progn 1460 (progn
1457 (switch-to-buffer-other-window (car buffer-point)) 1461 (switch-to-buffer-other-window (car buffer-point))
1458 (goto-char (cadr buffer-point)) 1462 (goto-char (cadr buffer-point))
1465 near point (selected by `find-function-function') and places point 1469 near point (selected by `find-function-function') and places point
1466 before the definition. 1470 before the definition.
1467 1471
1468 If the optional argument PATH is given, the library where FUNCTION is 1472 If the optional argument PATH is given, the library where FUNCTION is
1469 defined is searched in PATH instead of `load-path'" 1473 defined is searched in PATH instead of `load-path'"
1470 (interactive (ff-read-function)) 1474 (interactive (find-function-read-function))
1471 (let ((buffer-point (find-function-noselect function path))) 1475 (let ((buffer-point (find-function-noselect function path)))
1472 (if buffer-point 1476 (if buffer-point
1473 (progn 1477 (progn
1474 (switch-to-buffer-other-frame (car buffer-point)) 1478 (switch-to-buffer-other-frame (car buffer-point))
1475 (goto-char (cadr buffer-point)) 1479 (goto-char (cadr buffer-point))