Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 284:558f606b08ae r21-0b40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c42ec1d1cded
children 70ad99077275
comparison
equal deleted inserted replaced
283:fa3d41851a08 284:558f606b08ae
348 defn))) 348 defn)))
349 ;; no toolbar kludge 349 ;; no toolbar kludge
350 defn) 350 defn)
351 )) 351 ))
352 352
353 (defun describe-key-briefly (key) 353 (defun describe-key-briefly (key &optional insert)
354 "Print the name of the function KEY invokes. KEY is a string." 354 "Print the name of the function KEY invokes. KEY is a string.
355 (interactive "kDescribe key briefly: ") 355 If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
356 (let (defn menup) 356 (interactive "kDescribe key briefly: \nP")
357 (let ((standard-output (if insert (current-buffer) t))
358 defn menup)
357 (setq defn (key-or-menu-binding key 'menup)) 359 (setq defn (key-or-menu-binding key 'menup))
358 (if (or (null defn) (integerp defn)) 360 (if (or (null defn) (integerp defn))
359 (message "%s is undefined" (key-description key)) 361 (princ (format "%s is undefined" (key-description key)))
360 ;; If it's a keyboard macro which trivially invokes another command, 362 ;; If it's a keyboard macro which trivially invokes another command,
361 ;; document that instead. 363 ;; document that instead.
362 (if (or (stringp defn) (vectorp defn)) 364 (if (or (stringp defn) (vectorp defn))
363 (setq defn (or (key-binding defn) 365 (setq defn (or (key-binding defn)
364 defn))) 366 defn)))
365 (let ((last-event (and (vectorp key) 367 (let ((last-event (and (vectorp key)
366 (aref key (1- (length key)))))) 368 (aref key (1- (length key))))))
367 (message (if (or (button-press-event-p last-event) 369 (princ (format (cond (insert
368 (button-release-event-p last-event)) 370 "%s (%s)")
369 (gettext "%s at that spot runs the command %s") 371 ((or (button-press-event-p last-event)
370 (gettext "%s runs the command %s")) 372 (button-release-event-p last-event))
371 ;; This used to say 'This menu item' but it could also 373 (gettext "%s at that spot runs the command %s"))
372 ;; be a scrollbar event. We can't distinguish at the 374 (t
373 ;; moment. 375 (gettext "%s runs the command %s")))
374 (if menup "This item" (key-description key)) 376 ;; This used to say 'This menu item' but it
375 (format (if (symbolp defn) "`%s'" "%s") defn)))))) 377 ;; could also be a scrollbar event. We can't
378 ;; distinguish at the moment.
379 (if menup
380 (if insert "item" "This item")
381 (key-description key))
382 (if (symbolp defn) defn (prin1-to-string defn))))))))
376 383
377 ;; #### this is a horrible piece of shit function that should 384 ;; #### this is a horrible piece of shit function that should
378 ;; not exist. In FSF 19.30 this function has gotten three times 385 ;; not exist. In FSF 19.30 this function has gotten three times
379 ;; as long and has tons and tons of dumb shit checking 386 ;; as long and has tons and tons of dumb shit checking
380 ;; special-display-buffer-names and such crap. I absolutely 387 ;; special-display-buffer-names and such crap. I absolutely
460 ;; Use this function for displaying help when C-h something is pressed 467 ;; Use this function for displaying help when C-h something is pressed
461 ;; or in similar situations. Do *not* use it when you are displaying 468 ;; or in similar situations. Do *not* use it when you are displaying
462 ;; a help message and then prompting for input in the minibuffer -- 469 ;; a help message and then prompting for input in the minibuffer --
463 ;; this macro usually selects the help buffer, which is not what you 470 ;; this macro usually selects the help buffer, which is not what you
464 ;; want in those situations. 471 ;; want in those situations.
465 (defmacro with-displaying-help-buffer (name &rest body) 472
473 ;; #### Should really be a macro to eliminate the requirement of
474 ;; caller to code a lambda form in THUNK -- mrb
475
476 ;; #### BEFORE you rush to make this a macro, think about backward
477 ;; compatibility. The right way would be to create a macro with
478 ;; another name (which is a shame, because w-d-h-b is a perfect name
479 ;; for a macro) that uses with-displaying-help-buffer internally.
480
481 (defun with-displaying-help-buffer (thunk &optional name)
466 "Form which makes a help buffer with given NAME and evaluates BODY there. 482 "Form which makes a help buffer with given NAME and evaluates BODY there.
467 The actual name of the buffer is generated by the function `help-buffer-name'." 483 The actual name of the buffer is generated by the function `help-buffer-name'."
468 `(let* ((winconfig (current-window-configuration)) 484 (let* ((winconfig (current-window-configuration))
469 (was-one-window (one-window-p)) 485 (was-one-window (one-window-p))
470 (buffer-name (help-buffer-name ,name)) 486 (buffer-name (help-buffer-name name))
471 (help-not-visible 487 (help-not-visible
472 (not (and (windows-of-buffer buffer-name) ;shortcut 488 (not (and (windows-of-buffer buffer-name) ;shortcut
473 (member (selected-frame) 489 (memq (selected-frame)
474 (mapcar 'window-frame 490 (mapcar 'window-frame
475 (windows-of-buffer buffer-name))))))) 491 (windows-of-buffer buffer-name)))))))
476 (help-register-and-maybe-prune-excess buffer-name) 492 (help-register-and-maybe-prune-excess buffer-name)
477 (prog1 (with-output-to-temp-buffer buffer-name 493 (prog1 (with-output-to-temp-buffer buffer-name
478 (prog1 ,@body 494 (prog1 (funcall thunk)
479 (save-excursion 495 (save-excursion
480 (set-buffer standard-output) 496 (set-buffer standard-output)
481 (help-mode)))) 497 (help-mode))))
482 (let ((helpwin (get-buffer-window buffer-name))) 498 (let ((helpwin (get-buffer-window buffer-name)))
483 (when helpwin 499 (when helpwin
484 (with-current-buffer (window-buffer helpwin) 500 (with-current-buffer (window-buffer helpwin)
485 ;; If the *Help* buffer is already displayed on this 501 ;; If the *Help* buffer is already displayed on this
486 ;; frame, don't override the previous configuration 502 ;; frame, don't override the previous configuration
487 (when help-not-visible 503 (when help-not-visible
488 (set-frame-property (selected-frame) 504 (set-frame-property (selected-frame)
489 'help-window-config winconfig))) 505 'help-window-config winconfig)))
490 (when help-selects-help-window 506 (when help-selects-help-window
491 (select-window helpwin)) 507 (select-window helpwin))
492 (cond ((eq helpwin (selected-window)) 508 (cond ((eq helpwin (selected-window))
493 (display-message 'command 509 (display-message 'command
494 (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help."))) 510 (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help.")))
495 (was-one-window 511 (was-one-window
496 (display-message 'command 512 (display-message 'command
497 (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help."))) 513 (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help.")))
498 (t 514 (t
499 (display-message 'command 515 (display-message 'command
500 (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help."))))))))) 516 (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))))))))
501 (put 'with-displaying-help-buffer 'lisp-indent-function 1)
502 (put 'with-displaying-help-buffer 'edebug-form-spec '(form body))
503 517
504 (defun describe-key (key) 518 (defun describe-key (key)
505 "Display documentation of the function invoked by KEY. 519 "Display documentation of the function invoked by KEY.
506 KEY is a string, or vector of events. 520 KEY is a string, or vector of events.
507 When called interactively, KEY may also be a menu selection." 521 When called interactively, KEY may also be a menu selection."
508 (interactive "kDescribe key: ") 522 (interactive "kDescribe key: ")
509 (let ((defn (key-or-menu-binding key)) 523 (let ((defn (key-or-menu-binding key))
510 (key-string (key-description key))) 524 (key-string (key-description key)))
511 (if (or (null defn) (integerp defn)) 525 (if (or (null defn) (integerp defn))
512 (message "%s is undefined" key-string) 526 (message "%s is undefined" key-string)
513 (with-displaying-help-buffer (format "key `%s'" key-string) 527 (with-displaying-help-buffer
514 (princ key-string) 528 (lambda ()
515 (princ " runs ") 529 (princ key-string)
516 (if (symbolp defn) 530 (princ " runs ")
517 (princ (format "`%s'" defn)) 531 (if (symbolp defn)
518 (princ defn)) 532 (princ (format "`%s'" defn))
519 (princ "\n\n") 533 (princ defn))
520 (cond ((or (stringp defn) (vectorp defn)) 534 (princ "\n\n")
521 (let ((cmd (key-binding defn))) 535 (cond ((or (stringp defn) (vectorp defn))
522 (if (not cmd) 536 (let ((cmd (key-binding defn)))
523 (princ "a keyboard macro") 537 (if (not cmd)
524 (progn 538 (princ "a keyboard macro")
525 (princ "a keyboard macro which runs the command ") 539 (progn
526 (princ cmd) 540 (princ "a keyboard macro which runs the command ")
527 (princ ":\n\n") 541 (princ cmd)
528 (if (documentation cmd) (princ (documentation cmd))))))) 542 (princ ":\n\n")
529 ((and (consp defn) (not (eq 'lambda (car-safe defn)))) 543 (if (documentation cmd) (princ (documentation cmd)))))))
530 (let ((describe-function-show-arglist nil)) 544 ((and (consp defn) (not (eq 'lambda (car-safe defn))))
531 (describe-function-1 (car defn)))) 545 (let ((describe-function-show-arglist nil))
532 ((symbolp defn) 546 (describe-function-1 (car defn))))
533 (describe-function-1 defn)) 547 ((symbolp defn)
534 ((documentation defn) 548 (describe-function-1 defn))
535 (princ (documentation defn))) 549 ((documentation defn)
536 (t 550 (princ (documentation defn)))
537 (princ "not documented"))))))) 551 (t
552 (princ "not documented"))))
553 (format "key `%s'" key-string)))))
538 554
539 (defun describe-mode () 555 (defun describe-mode ()
540 "Display documentation of current major mode and minor modes. 556 "Display documentation of current major mode and minor modes.
541 For this to work correctly for a minor mode, the mode's indicator variable 557 For this to work correctly for a minor mode, the mode's indicator variable
542 \(listed in `minor-mode-alist') must also be a function whose documentation 558 \(listed in `minor-mode-alist') must also be a function whose documentation
543 describes the minor mode." 559 describes the minor mode."
544 (interactive) 560 (interactive)
545 (with-displaying-help-buffer (format "%s mode" mode-name) 561 (with-displaying-help-buffer
546 ;; XEmacs change: print the major-mode documentation before 562 (lambda ()
547 ;; the minor modes. 563 ;; XEmacs change: print the major-mode documentation before
548 (princ mode-name) 564 ;; the minor modes.
549 (princ " mode:\n") 565 (princ mode-name)
550 (princ (documentation major-mode)) 566 (princ " mode:\n")
551 (princ "\n\n----\n\n") 567 (princ (documentation major-mode))
552 (let ((minor-modes minor-mode-alist)) 568 (princ "\n\n----\n\n")
553 (while minor-modes 569 (let ((minor-modes minor-mode-alist))
554 (let* ((minor-mode (car (car minor-modes))) 570 (while minor-modes
555 (indicator (car (cdr (car minor-modes))))) 571 (let* ((minor-mode (car (car minor-modes)))
556 ;; Document a minor mode if it is listed in minor-mode-alist, 572 (indicator (car (cdr (car minor-modes)))))
557 ;; bound locally in this buffer, non-nil, and has a function 573 ;; Document a minor mode if it is listed in minor-mode-alist,
558 ;; definition. 574 ;; bound locally in this buffer, non-nil, and has a function
559 (if (and (boundp minor-mode) 575 ;; definition.
560 (symbol-value minor-mode) 576 (if (and (boundp minor-mode)
561 (fboundp minor-mode)) 577 (symbol-value minor-mode)
562 (let ((pretty-minor-mode minor-mode)) 578 (fboundp minor-mode))
563 (if (string-match "-mode\\'" (symbol-name minor-mode)) 579 (let ((pretty-minor-mode minor-mode))
564 (setq pretty-minor-mode 580 (if (string-match "-mode\\'" (symbol-name minor-mode))
565 (capitalize 581 (setq pretty-minor-mode
566 (substring (symbol-name minor-mode) 582 (capitalize
567 0 (match-beginning 0))))) 583 (substring (symbol-name minor-mode)
568 (while (and (consp indicator) (extentp (car indicator))) 584 0 (match-beginning 0)))))
569 (setq indicator (cdr indicator))) 585 (while (and (consp indicator) (extentp (car indicator)))
570 (while (and indicator (symbolp indicator)) 586 (setq indicator (cdr indicator)))
571 (setq indicator (symbol-value indicator))) 587 (while (and indicator (symbolp indicator))
572 (princ (format "%s minor mode (indicator%s):\n" 588 (setq indicator (symbol-value indicator)))
573 pretty-minor-mode indicator)) 589 (princ (format "%s minor mode (indicator%s):\n"
574 (princ (documentation minor-mode)) 590 pretty-minor-mode indicator))
575 (princ "\n\n----\n\n")))) 591 (princ (documentation minor-mode))
576 (setq minor-modes (cdr minor-modes)))))) 592 (princ "\n\n----\n\n"))))
593 (setq minor-modes (cdr minor-modes)))))
594 (format "%s mode" mode-name)))
577 595
578 ;; So keyboard macro definitions are documented correctly 596 ;; So keyboard macro definitions are documented correctly
579 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) 597 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
580 598
581 (defun describe-distribution () 599 (defun describe-distribution ()
624 If the optional argument PREFIX is supplied, only commands which 642 If the optional argument PREFIX is supplied, only commands which
625 start with that sequence of keys are described. 643 start with that sequence of keys are described.
626 If the second argument (prefix arg, interactively) is non-null 644 If the second argument (prefix arg, interactively) is non-null
627 then only the mouse bindings are displayed." 645 then only the mouse bindings are displayed."
628 (interactive (list nil current-prefix-arg)) 646 (interactive (list nil current-prefix-arg))
629 (let (buf) 647 (with-displaying-help-buffer
630 (with-displaying-help-buffer (format "bindings for %s" major-mode) 648 (lambda ()
631 (setq buf (describe-bindings-1 prefix mouse-only-p))) 649 (describe-bindings-1 prefix mouse-only-p))
632 buf)) 650 (format "bindings for %s" major-mode)))
633 651
634 (defun describe-bindings-1 (&optional prefix mouse-only-p) 652 (defun describe-bindings-1 (&optional prefix mouse-only-p)
635 (let ((heading (if mouse-only-p 653 (let ((heading (if mouse-only-p
636 (gettext "button binding\n------ -------\n") 654 (gettext "button binding\n------ -------\n")
637 (gettext "key binding\n--- -------\n"))) 655 (gettext "key binding\n--- -------\n")))
678 i) 696 i)
679 (setq i 0) 697 (setq i 0)
680 (while (< i (length prefix)) 698 (while (< i (length prefix))
681 (aset prefix i (aref key i)) 699 (aset prefix i (aref key i))
682 (setq i (1+ i))) 700 (setq i (1+ i)))
683 (with-displaying-help-buffer (format "%s prefix" (key-description prefix)) 701 (with-displaying-help-buffer
684 (princ "Key bindings starting with ") 702 (lambda ()
685 (princ (key-description prefix)) 703 (princ "Key bindings starting with ")
686 (princ ":\n\n") 704 (princ (key-description prefix))
687 (describe-bindings-1 prefix nil)))) 705 (princ ":\n\n")
706 (describe-bindings-1 prefix nil))
707 (format "%s prefix" (key-description prefix)))))
688 708
689 ;; Make C-h after a prefix, when not specifically bound, 709 ;; Make C-h after a prefix, when not specifically bound,
690 ;; run describe-prefix-bindings. 710 ;; run describe-prefix-bindings.
691 (setq prefix-help-command 'describe-prefix-bindings) 711 (setq prefix-help-command 'describe-prefix-bindings)
692 712
693 (defun describe-installation () 713 (defun describe-installation ()
694 "Display a buffer showing information about this XEmacs was compiled." 714 "Display a buffer showing information about this XEmacs was compiled."
695 (interactive) 715 (interactive)
696 (if (and (boundp 'Installation-string) 716 (if (and (boundp 'Installation-string)
697 (stringp Installation-string)) 717 (stringp Installation-string))
698 (with-displaying-help-buffer "Installation" 718 (with-displaying-help-buffer
699 (princ Installation-string)) 719 (lambda ()
720 (princ Installation-string))
721 "Installation")
700 (error "No Installation information available."))) 722 (error "No Installation information available.")))
701 723
702 (defun view-emacs-news () 724 (defun view-emacs-news ()
703 "Display info on recent changes to XEmacs." 725 "Display info on recent changes to XEmacs."
704 (interactive) 726 (interactive)
743 (defun view-lossage () 765 (defun view-lossage ()
744 "Display recent input keystrokes and recent minibuffer messages. 766 "Display recent input keystrokes and recent minibuffer messages.
745 The number of keys shown is controlled by `view-lossage-key-count'. 767 The number of keys shown is controlled by `view-lossage-key-count'.
746 The number of messages shown is controlled by `view-lossage-message-count'." 768 The number of messages shown is controlled by `view-lossage-message-count'."
747 (interactive) 769 (interactive)
748 (with-displaying-help-buffer "lossage" 770 (with-displaying-help-buffer
749 (princ (key-description (recent-keys view-lossage-key-count))) 771 (lambda ()
750 (save-excursion 772 (princ (key-description (recent-keys view-lossage-key-count)))
751 (set-buffer standard-output) 773 (save-excursion
752 (goto-char (point-min)) 774 (set-buffer standard-output)
753 (insert "Recent keystrokes:\n\n") 775 (goto-char (point-min))
754 (while (progn (move-to-column 50) (not (eobp))) 776 (insert "Recent keystrokes:\n\n")
755 (search-forward " " nil t) 777 (while (progn (move-to-column 50) (not (eobp)))
756 (insert "\n"))) 778 (search-forward " " nil t)
757 ;; XEmacs addition: copy the messages from " *Message-Log*", 779 (insert "\n")))
758 ;; reversing their order and handling multiline messages 780 ;; XEmacs addition: copy the messages from " *Message-Log*",
759 ;; correctly. 781 ;; reversing their order and handling multiline messages
760 (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n") 782 ;; correctly.
761 (save-excursion 783 (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n")
762 (let ((buffer (get-buffer-create " *Message-Log*")) 784 (save-excursion
763 (count 0) 785 (let ((buffer (get-buffer-create " *Message-Log*"))
764 oldpoint extent) 786 (count 0)
765 (goto-char (point-max buffer) buffer) 787 oldpoint extent)
766 (set-buffer standard-output) 788 (goto-char (point-max buffer) buffer)
767 (while (and (not (bobp buffer)) 789 (set-buffer standard-output)
768 (< count view-lossage-message-count)) 790 (while (and (not (bobp buffer))
769 (setq oldpoint (point buffer)) 791 (< count view-lossage-message-count))
770 (setq extent (extent-at oldpoint buffer 792 (setq oldpoint (point buffer))
771 'message-multiline nil 'before)) 793 (setq extent (extent-at oldpoint buffer
772 ;; If the message was multiline, move all the way to the 794 'message-multiline nil 'before))
773 ;; beginning. 795 ;; If the message was multiline, move all the way to the
774 (if extent 796 ;; beginning.
775 (goto-char (extent-start-position extent) buffer) 797 (if extent
776 (forward-line -1 buffer)) 798 (goto-char (extent-start-position extent) buffer)
777 (insert-buffer-substring buffer (point buffer) oldpoint) 799 (forward-line -1 buffer))
778 (incf count)))))) 800 (insert-buffer-substring buffer (point buffer) oldpoint)
801 (incf count)))))
802 "lossage"))
779 803
780 (define-function 'help 'help-for-help) 804 (define-function 'help 'help-for-help)
781 805
782 (make-help-screen help-for-help 806 (make-help-screen help-for-help
783 "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:" 807 "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:"
912 (format (gettext "Describe function (default %s): ") 936 (format (gettext "Describe function (default %s): ")
913 fn) 937 fn)
914 (gettext "Describe function: ")) 938 (gettext "Describe function: "))
915 obarray 'fboundp t nil 'function-history)))) 939 obarray 'fboundp t nil 'function-history))))
916 (list (if (equal val "") fn (intern val))))) 940 (list (if (equal val "") fn (intern val)))))
917 (with-displaying-help-buffer (format "function `%s'" function) 941 (with-displaying-help-buffer
918 (describe-function-1 function))) 942 (lambda ()
943 (describe-function-1 function)
944 ;; Return the text we displayed.
945 (buffer-string nil nil standard-output))
946 (format "function `%s'" function)))
919 947
920 (defun function-obsolete-p (function) 948 (defun function-obsolete-p (function)
921 "Return non-nil if FUNCTION is obsolete." 949 "Return non-nil if FUNCTION is obsolete."
922 (not (null (get function 'byte-obsolete-info)))) 950 (not (null (get function 'byte-obsolete-info))))
923 951
1197 (if v 1225 (if v
1198 (format "Describe variable (default %s): " v) 1226 (format "Describe variable (default %s): " v)
1199 (gettext "Describe variable: ")) 1227 (gettext "Describe variable: "))
1200 obarray 'boundp t nil 'variable-history)))) 1228 obarray 'boundp t nil 'variable-history))))
1201 (list (if (equal val "") v (intern val))))) 1229 (list (if (equal val "") v (intern val)))))
1202 (with-displaying-help-buffer (format "variable `%s'" variable) 1230 (with-displaying-help-buffer
1203 (let ((origvar variable) 1231 (lambda ()
1204 aliases) 1232 (let ((origvar variable)
1205 (let ((print-escape-newlines t)) 1233 aliases)
1206 (princ (format "`%s' is " (symbol-name variable))) 1234 (let ((print-escape-newlines t))
1207 (while (variable-alias variable) 1235 (princ (format "`%s' is " (symbol-name variable)))
1208 (let ((newvar (variable-alias variable))) 1236 (while (variable-alias variable)
1209 (if aliases 1237 (let ((newvar (variable-alias variable)))
1210 ;; I18N3 Need gettext due to concat 1238 (if aliases
1211 (setq aliases 1239 ;; I18N3 Need gettext due to concat
1212 (concat aliases 1240 (setq aliases
1213 (format "\n which is an alias for `%s'," 1241 (concat aliases
1214 (symbol-name newvar)))) 1242 (format "\n which is an alias for `%s',"
1215 (setq aliases 1243 (symbol-name newvar))))
1216 (format "an alias for `%s'," 1244 (setq aliases
1217 (symbol-name newvar)))) 1245 (format "an alias for `%s',"
1218 (setq variable newvar))) 1246 (symbol-name newvar))))
1219 (if aliases 1247 (setq variable newvar)))
1220 (princ (format "%s" aliases))) 1248 (if aliases
1221 (princ (built-in-variable-doc variable)) 1249 (princ (format "%s" aliases)))
1222 (princ ".\n") 1250 (princ (built-in-variable-doc variable))
1223 (let ((file-name (describe-symbol-find-file variable))) 1251 (princ ".\n")
1224 (if file-name 1252 (let ((file-name (describe-symbol-find-file variable)))
1225 (princ (format " -- loaded from \"%s\"\n" file-name)))) 1253 (if file-name
1226 (princ "\nValue: ") 1254 (princ (format " -- loaded from \"%s\"\n" file-name))))
1227 (if (not (boundp variable)) 1255 (princ "\nValue: ")
1228 (princ "void\n") 1256 (if (not (boundp variable))
1229 (prin1 (symbol-value variable)) 1257 (princ "void\n")
1230 (terpri)) 1258 (prin1 (symbol-value variable))
1231 (terpri) 1259 (terpri))
1232 (cond ((local-variable-p variable (current-buffer)) 1260 (terpri)
1233 (let* ((void (cons nil nil)) 1261 (cond ((local-variable-p variable (current-buffer))
1234 (def (condition-case nil 1262 (let* ((void (cons nil nil))
1235 (default-value variable) 1263 (def (condition-case nil
1236 (error void)))) 1264 (default-value variable)
1237 (princ "This value is specific to the current buffer.\n") 1265 (error void))))
1238 (if (local-variable-p variable nil) 1266 (princ "This value is specific to the current buffer.\n")
1239 (princ "(Its value is local to each buffer.)\n")) 1267 (if (local-variable-p variable nil)
1240 (terpri) 1268 (princ "(Its value is local to each buffer.)\n"))
1241 (if (if (eq def void) 1269 (terpri)
1242 (boundp variable) 1270 (if (if (eq def void)
1243 (not (eq (symbol-value variable) def))) 1271 (boundp variable)
1244 ;; #### I18N3 doesn't localize properly! 1272 (not (eq (symbol-value variable) def)))
1245 (progn (princ "Default-value: ") 1273 ;; #### I18N3 doesn't localize properly!
1246 (if (eq def void) 1274 (progn (princ "Default-value: ")
1247 (princ "void\n") 1275 (if (eq def void)
1248 (prin1 def) 1276 (princ "void\n")
1249 (terpri)) 1277 (prin1 def)
1250 (terpri))))) 1278 (terpri))
1251 ((local-variable-p variable (current-buffer) t) 1279 (terpri)))))
1252 (princ "Setting it would make its value buffer-local.\n\n")))) 1280 ((local-variable-p variable (current-buffer) t)
1253 (princ "Documentation:") 1281 (princ "Setting it would make its value buffer-local.\n\n"))))
1254 (terpri) 1282 (princ "Documentation:")
1255 (let ((doc (documentation-property variable 'variable-documentation)) 1283 (terpri)
1256 (obsolete (variable-obsoleteness-doc origvar)) 1284 (let ((doc (documentation-property variable 'variable-documentation))
1257 (compatible (variable-compatibility-doc origvar))) 1285 (obsolete (variable-obsoleteness-doc origvar))
1258 (when obsolete 1286 (compatible (variable-compatibility-doc origvar)))
1259 (princ obsolete) 1287 (when obsolete
1260 (terpri) 1288 (princ obsolete)
1261 (terpri)) 1289 (terpri)
1262 (when compatible 1290 (terpri))
1263 (princ compatible) 1291 (when compatible
1264 (terpri) 1292 (princ compatible)
1265 (terpri)) 1293 (terpri)
1266 ;; don't bother to print anything if variable is obsolete and aliased. 1294 (terpri))
1267 (when (or (not obsolete) (not aliases)) 1295 ;; don't bother to print anything if variable is obsolete and aliased.
1268 (if doc 1296 (when (or (not obsolete) (not aliases))
1269 ;; note: documentation-property calls substitute-command-keys. 1297 (if doc
1270 (princ doc) 1298 ;; note: documentation-property calls substitute-command-keys.
1271 (princ "not documented as a variable.")))) 1299 (princ doc)
1272 (terpri)))) 1300 (princ "not documented as a variable."))))
1301 (terpri)))
1302 (format "variable `%s'" variable)))
1273 1303
1274 (defun sorted-key-descriptions (keys &optional separator) 1304 (defun sorted-key-descriptions (keys &optional separator)
1275 "Sort and separate the key descriptions for KEYS. 1305 "Sort and separate the key descriptions for KEYS.
1276 The sorting is done by length (shortest bindings first), and the bindings 1306 The sorting is done by length (shortest bindings first), and the bindings
1277 are separated with SEPARATOR (\", \" by default)." 1307 are separated with SEPARATOR (\", \" by default)."
1278 (mapconcat 'key-description 1308 (mapconcat 'key-description
1279 (sort keys #'(lambda (x y) 1309 (sort keys #'(lambda (x y)
1280 (< (length x) (length y)))) 1310 (< (length x) (length y))))
1281 (or separator ", "))) 1311 (or separator ", ")))
1282 1312
1283 (defun where-is (definition) 1313 (defun where-is (definition &optional insert)
1284 "Print message listing key sequences that invoke specified command. 1314 "Print message listing key sequences that invoke specified command.
1285 Argument is a command definition, usually a symbol with a function definition. 1315 Argument is a command definition, usually a symbol with a function definition.
1286 When run interactively, it defaults to any function found by 1316 When run interactively, it defaults to any function found by
1287 `function-at-point'." 1317 `function-at-point'.
1318 If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
1288 (interactive 1319 (interactive
1289 (let ((fn (function-at-point)) 1320 (let ((fn (function-at-point))
1290 (enable-recursive-minibuffers t) 1321 (enable-recursive-minibuffers t)
1291 val) 1322 val)
1292 (setq val (read-command 1323 (setq val (read-command
1293 (if fn (format "Where is command (default %s): " fn) 1324 (if fn (format "Where is command (default %s): " fn)
1294 "Where is command: "))) 1325 "Where is command: ")))
1295 (list (if (equal (symbol-name val) "") 1326 (list (if (equal (symbol-name val) "")
1296 fn val)))) 1327 fn val)
1328 current-prefix-arg)))
1297 (let ((keys (where-is-internal definition))) 1329 (let ((keys (where-is-internal definition)))
1298 (if keys 1330 (if keys
1299 (message "%s is on %s" definition (sorted-key-descriptions keys)) 1331 (if insert
1300 (message "%s is not on any keys" definition))) 1332 (princ (format "%s (%s)" (sorted-key-descriptions keys)
1333 definition) (current-buffer))
1334 (message "%s is on %s" definition (sorted-key-descriptions keys)))
1335 (if insert
1336 (princ (format (if (commandp definition) "M-x %s RET"
1337 "M-: (%s ...)") definition) (current-buffer))
1338 (message "%s is not on any keys" definition))))
1301 nil) 1339 nil)
1302 1340
1303 ;; `locate-library' moved to "packages.el" 1341 ;; `locate-library' moved to "packages.el"
1304 1342
1305 1343
1307 1345
1308 (defun describe-syntax () 1346 (defun describe-syntax ()
1309 "Describe the syntax specifications in the syntax table. 1347 "Describe the syntax specifications in the syntax table.
1310 The descriptions are inserted in a buffer, which is then displayed." 1348 The descriptions are inserted in a buffer, which is then displayed."
1311 (interactive) 1349 (interactive)
1312 (with-displaying-help-buffer (format "syntax-table for %s" major-mode) 1350 (with-displaying-help-buffer
1313 ;; defined in syntax.el 1351 (lambda ()
1314 (describe-syntax-table (syntax-table) standard-output))) 1352 ;; defined in syntax.el
1353 (describe-syntax-table (syntax-table) standard-output))
1354 (format "syntax-table for %s" major-mode)))
1315 1355
1316 (defun list-processes () 1356 (defun list-processes ()
1317 "Display a list of all processes. 1357 "Display a list of all processes.
1318 \(Any processes listed as Exited or Signaled are actually eliminated 1358 \(Any processes listed as Exited or Signaled are actually eliminated
1319 after the listing is made.)" 1359 after the listing is made.)"