Mercurial > emacs

comparison lisp/help-fns.el @ 83380:94f174e5569d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged from miles@gnu.org--gnu-2005 (patch 543) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-543 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-420
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 17 Sep 2005 19:00:49 +0000
parents 532e0a9335a9 a6481386d6b6
children d84f940244dc
comparison
equal deleted inserted replaced
83379:23f939241b7d 83380:94f174e5569d
520 (unless (frame-live-p frame) (setq frame (selected-frame))) 520 (unless (frame-live-p frame) (setq frame (selected-frame)))
521 (if (not (symbolp variable)) 521 (if (not (symbolp variable))
522 (message "You did not specify a variable") 522 (message "You did not specify a variable")
523 (save-excursion 523 (save-excursion
524 (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) 524 (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
525 val locus) 525 val val-start-pos locus)
526 ;; Extract the value before setting up the output buffer, 526 ;; Extract the value before setting up the output buffer,
527 ;; in case `buffer' *is* the output buffer. 527 ;; in case `buffer' *is* the output buffer.
528 (unless valvoid 528 (unless valvoid
529 (with-selected-frame frame 529 (with-selected-frame frame
530 (with-current-buffer buffer 530 (with-current-buffer buffer
533 (help-setup-xref (list #'describe-variable variable buffer) 533 (help-setup-xref (list #'describe-variable variable buffer)
534 (interactive-p)) 534 (interactive-p))
535 (with-output-to-temp-buffer (help-buffer) 535 (with-output-to-temp-buffer (help-buffer)
536 (with-current-buffer buffer 536 (with-current-buffer buffer
537 (prin1 variable) 537 (prin1 variable)
538 (if valvoid
539 (princ " is void")
540 (with-current-buffer standard-output
541 (princ "'s value is ")
542 (terpri)
543 (let ((from (point)))
544 (pp val)
545 ;; Hyperlinks in variable's value are quite frequently
546 ;; inappropriate e.g C-h v <RET> features <RET>
547 ;; (help-xref-on-pp from (point))
548 (if (< (point) (+ from 20))
549 (delete-region (1- from) from)))))
550 (terpri)
551 (when locus
552 (if (bufferp locus)
553 (princ (format "%socal in buffer %s; "
554 (if (get variable 'permanent-local)
555 "Permanently l" "L")
556 (buffer-name)))
557 (princ (format "It is a frame-local variable; ")))
558 (if (not (default-boundp variable))
559 (princ "globally void")
560 (let ((val (default-value variable)))
561 (with-current-buffer standard-output
562 (princ "global value is ")
563 (terpri)
564 ;; Fixme: pp can take an age if you happen to
565 ;; ask for a very large expression. We should
566 ;; probably print it raw once and check it's a
567 ;; sensible size before prettyprinting. -- fx
568 (let ((from (point)))
569 (pp val)
570 ;; See previous comment for this function.
571 ;; (help-xref-on-pp from (point))
572 (if (< (point) (+ from 20))
573 (delete-region (1- from) from))))))
574 (terpri))
575 (terpri)
576 (with-current-buffer standard-output
577 (when (> (count-lines (point-min) (point-max)) 10)
578 ;; Note that setting the syntax table like below
579 ;; makes forward-sexp move over a `'s' at the end
580 ;; of a symbol.
581 (set-syntax-table emacs-lisp-mode-syntax-table)
582 (goto-char (point-min))
583 (if valvoid
584 (forward-line 1)
585 (forward-sexp 1)
586 (delete-region (point) (progn (end-of-line) (point)))
587 (save-excursion
588 (insert "\n\nValue:")
589 (set (make-local-variable 'help-button-cache)
590 (point-marker)))
591 (insert " value is shown ")
592 (insert-button "below"
593 'action help-button-cache
594 'follow-link t
595 'help-echo "mouse-2, RET: show value")
596 (insert ".\n\n")))
597 ;; Add a note for variables that have been make-var-buffer-local.
598 (when (and (local-variable-if-set-p variable)
599 (or (not (local-variable-p variable))
600 (with-temp-buffer
601 (local-variable-if-set-p variable))))
602 (save-excursion
603 (forward-line -1)
604 (insert "Automatically becomes buffer-local when set in any fashion.\n"))))
605 ;; Mention if it's an alias
606 (let* ((alias (condition-case nil
607 (indirect-variable variable)
608 (error variable)))
609 (obsolete (get variable 'byte-obsolete-variable))
610 (doc (or (documentation-property variable 'variable-documentation)
611 (documentation-property alias 'variable-documentation))))
612 (unless (eq alias variable)
613 (princ (format "This variable is an alias for `%s'." alias))
614 (terpri)
615 (terpri))
616 (when obsolete
617 (princ "This variable is obsolete")
618 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
619 (princ ";") (terpri)
620 (princ (if (stringp (car obsolete)) (car obsolete)
621 (format "use `%s' instead." (car obsolete))))
622 (terpri)
623 (terpri))
624 (princ (or doc "Not documented as a variable.")))
625 ;; Make a link to customize if this variable can be customized.
626 (if (custom-variable-p variable)
627 (let ((customize-label "customize"))
628 (terpri)
629 (terpri)
630 (princ (concat "You can " customize-label " this variable."))
631 (with-current-buffer standard-output
632 (save-excursion
633 (re-search-backward
634 (concat "\\(" customize-label "\\)") nil t)
635 (help-xref-button 1 'help-customize-variable variable)))))
636 ;; Make a hyperlink to the library if appropriate. (Don't 538 ;; Make a hyperlink to the library if appropriate. (Don't
637 ;; change the format of the buffer's initial line in case 539 ;; change the format of the buffer's initial line in case
638 ;; anything expects the current format.) 540 ;; anything expects the current format.)
639 (let ((file-name (symbol-file variable 'defvar))) 541 (let ((file-name (symbol-file variable 'defvar)))
640 (when (equal file-name "loaddefs.el") 542 (when (equal file-name "loaddefs.el")
654 ;; It's a variable not defined in Elisp but in C. 556 ;; It's a variable not defined in Elisp but in C.
655 (setq file-name 557 (setq file-name
656 (if (get-buffer " *DOC*") 558 (if (get-buffer " *DOC*")
657 (help-C-file-name variable 'var) 559 (help-C-file-name variable 'var)
658 'C-source))) 560 'C-source)))
659 (when file-name 561 (if file-name
660 (princ "\n\nDefined in `") 562 (progn
661 (princ (if (eq file-name 'C-source) "C source code" file-name)) 563 (princ " is a variable defined in `")
662 (princ "'.") 564 (princ (if (eq file-name 'C-source) "C source code" file-name))
663 (with-current-buffer standard-output 565 (princ "'.\n")
664 (save-excursion 566 (with-current-buffer standard-output
665 (re-search-backward "`\\([^`']+\\)'" nil t) 567 (save-excursion
666 (help-xref-button 1 'help-variable-def 568 (re-search-backward "`\\([^`']+\\)'" nil t)
667 variable file-name))))) 569 (help-xref-button 1 'help-variable-def
668 570 variable file-name)))
571 (if valvoid
572 (princ "It is void as a variable.\n")
573 (princ "Its ")))
574 (if valvoid
575 (princ " is void as a variable.\n")
576 (princ "'s "))))
577 (if valvoid
578 nil
579 (with-current-buffer standard-output
580 (setq val-start-pos (point))
581 (princ "value is ")
582 (terpri)
583 (let ((from (point)))
584 (pp val)
585 ;; Hyperlinks in variable's value are quite frequently
586 ;; inappropriate e.g C-h v <RET> features <RET>
587 ;; (help-xref-on-pp from (point))
588 (if (< (point) (+ from 20))
589 (delete-region (1- from) from)))))
590 (terpri)
591
592 (when locus
593 (if (bufferp locus)
594 (princ (format "%socal in buffer %s; "
595 (if (get variable 'permanent-local)
596 "Permanently l" "L")
597 (buffer-name)))
598 (princ (format "It is a frame-local variable; ")))
599 (if (not (default-boundp variable))
600 (princ "globally void")
601 (let ((val (default-value variable)))
602 (with-current-buffer standard-output
603 (princ "global value is ")
604 (terpri)
605 ;; Fixme: pp can take an age if you happen to
606 ;; ask for a very large expression. We should
607 ;; probably print it raw once and check it's a
608 ;; sensible size before prettyprinting. -- fx
609 (let ((from (point)))
610 (pp val)
611 ;; See previous comment for this function.
612 ;; (help-xref-on-pp from (point))
613 (if (< (point) (+ from 20))
614 (delete-region (1- from) from)))))))
615 ;; Add a note for variables that have been make-var-buffer-local.
616 (when (and (local-variable-if-set-p variable)
617 (or (not (local-variable-p variable))
618 (with-temp-buffer
619 (local-variable-if-set-p variable))))
620 (princ "\nAutomatically becomes buffer-local when set in any fashion.\n"))
621 (terpri)
622
623 ;; If the value is large, move it to the end.
624 (with-current-buffer standard-output
625 (when (> (count-lines (point-min) (point-max)) 10)
626 ;; Note that setting the syntax table like below
627 ;; makes forward-sexp move over a `'s' at the end
628 ;; of a symbol.
629 (set-syntax-table emacs-lisp-mode-syntax-table)
630 (goto-char val-start-pos)
631 (delete-region (point) (progn (end-of-line) (point)))
632 (save-excursion
633 (insert "\n\nValue:")
634 (set (make-local-variable 'help-button-cache)
635 (point-marker)))
636 (insert "value is shown ")
637 (insert-button "below"
638 'action help-button-cache
639 'follow-link t
640 'help-echo "mouse-2, RET: show value")
641 (insert ".\n\n")))
642
643 ;; Mention if it's an alias
644 (let* ((alias (condition-case nil
645 (indirect-variable variable)
646 (error variable)))
647 (obsolete (get variable 'byte-obsolete-variable))
648 (doc (or (documentation-property variable 'variable-documentation)
649 (documentation-property alias 'variable-documentation))))
650 (unless (eq alias variable)
651 (princ (format "\nThis variable is an alias for `%s'.\n" alias)))
652 (when obsolete
653 (princ "\nThis variable is obsolete")
654 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
655 (princ ";") (terpri)
656 (princ (if (stringp (car obsolete)) (car obsolete)
657 (format "use `%s' instead." (car obsolete))))
658 (terpri))
659 (princ "Documentation:\n")
660 (princ (or doc "Not documented as a variable.")))
661 ;; Make a link to customize if this variable can be customized.
662 (if (custom-variable-p variable)
663 (let ((customize-label "customize"))
664 (terpri)
665 (terpri)
666 (princ (concat "You can " customize-label " this variable."))
667 (with-current-buffer standard-output
668 (save-excursion
669 (re-search-backward
670 (concat "\\(" customize-label "\\)") nil t)
671 (help-xref-button 1 'help-customize-variable variable)))))
669 (print-help-return-message) 672 (print-help-return-message)
670 (save-excursion 673 (save-excursion
671 (set-buffer standard-output) 674 (set-buffer standard-output)
672 ;; Return the text we displayed. 675 ;; Return the text we displayed.
673 (buffer-string)))))))) 676 (buffer-string))))))))