Mercurial > emacs
comparison lisp/help.el @ 32183:3e4bdf7c90c4
(help-xref-on-pp): Use match-string.
(describe-variable): New arg BUFFER.
Store the current buffer in the help-xref-stack.
(temp-buffer-resize-mode): Use define-minor-mode.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 05 Oct 2000 22:27:38 +0000 |
parents | 080006769824 |
children | ab059a552fa2 |
comparison
equal
deleted
inserted
replaced
32182:f5d09b70a4b8 | 32183:3e4bdf7c90c4 |
---|---|
149 (setq buffer-read-only nil)) | 149 (setq buffer-read-only nil)) |
150 | 150 |
151 (add-hook 'temp-buffer-setup-hook 'help-mode-setup) | 151 (add-hook 'temp-buffer-setup-hook 'help-mode-setup) |
152 | 152 |
153 (defun help-mode-finish () | 153 (defun help-mode-finish () |
154 (when (eq major-mode 'help-mode) | 154 (when (eq major-mode 'help-mode) |
155 ;; View mode's read-only status of existing *Help* buffer is lost | 155 ;; View mode's read-only status of existing *Help* buffer is lost |
156 ;; by with-output-to-temp-buffer. | 156 ;; by with-output-to-temp-buffer. |
157 (toggle-read-only 1) | 157 (toggle-read-only 1) |
158 (help-make-xrefs (current-buffer))) | 158 (help-make-xrefs (current-buffer))) |
159 (setq view-return-to-alist | 159 (setq view-return-to-alist |
788 (while (not (eobp)) | 788 (while (not (eobp)) |
789 (cond | 789 (cond |
790 ((looking-at "\"") (forward-sexp 1)) | 790 ((looking-at "\"") (forward-sexp 1)) |
791 ((looking-at "#<") (search-forward ">" nil 'move)) | 791 ((looking-at "#<") (search-forward ">" nil 'move)) |
792 ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") | 792 ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") |
793 (let* ((sym (intern-soft | 793 (let* ((sym (intern-soft (match-string 1))) |
794 (buffer-substring (match-beginning 1) | |
795 (match-end 1)))) | |
796 (fn (cond ((fboundp sym) #'describe-function) | 794 (fn (cond ((fboundp sym) #'describe-function) |
797 ((or (memq sym '(t nil)) | 795 ((or (memq sym '(t nil)) |
798 (keywordp sym)) | 796 (keywordp sym)) |
799 nil) | 797 nil) |
800 ((and sym (boundp sym)) | 798 ((and sym (boundp sym)) |
802 (when fn (help-xref-button 1 fn sym))) | 800 (when fn (help-xref-button 1 fn sym))) |
803 (goto-char (match-end 1))) | 801 (goto-char (match-end 1))) |
804 (t (forward-char 1)))))) | 802 (t (forward-char 1)))))) |
805 (set-syntax-table ost)))) | 803 (set-syntax-table ost)))) |
806 | 804 |
807 (defun describe-variable (variable) | 805 (defun describe-variable (variable &optional buffer) |
808 "Display the full documentation of VARIABLE (a symbol). | 806 "Display the full documentation of VARIABLE (a symbol). |
809 Returns the documentation as a string, also." | 807 Returns the documentation as a string, also. |
810 (interactive | 808 If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), |
809 it is displayed along with the global value." | |
810 (interactive | |
811 (let ((v (variable-at-point)) | 811 (let ((v (variable-at-point)) |
812 (enable-recursive-minibuffers t) | 812 (enable-recursive-minibuffers t) |
813 val) | 813 val) |
814 (setq val (completing-read (if (symbolp v) | 814 (setq val (completing-read (if (symbolp v) |
815 (format | 815 (format |
817 "Describe variable: ") | 817 "Describe variable: ") |
818 obarray 'boundp t nil nil | 818 obarray 'boundp t nil nil |
819 (if (symbolp v) (symbol-name v)))) | 819 (if (symbolp v) (symbol-name v)))) |
820 (list (if (equal val "") | 820 (list (if (equal val "") |
821 v (intern val))))) | 821 v (intern val))))) |
822 (if (symbolp variable) | 822 (unless (bufferp buffer) (setq buffer (current-buffer))) |
823 (let (valvoid) | 823 (if (not (symbolp variable)) |
824 (message "You did not specify a variable") | |
825 (let (valvoid) | |
826 (with-current-buffer buffer | |
824 (with-output-to-temp-buffer "*Help*" | 827 (with-output-to-temp-buffer "*Help*" |
825 (prin1 variable) | 828 (prin1 variable) |
826 (if (not (boundp variable)) | 829 (if (not (boundp variable)) |
827 (progn | 830 (progn |
828 (princ " is void") | 831 (princ " is void") |
851 (let ((from (point))) | 854 (let ((from (point))) |
852 (pp val) | 855 (pp val) |
853 (help-xref-on-pp from (point)))))) | 856 (help-xref-on-pp from (point)))))) |
854 (terpri))) | 857 (terpri))) |
855 (terpri) | 858 (terpri) |
856 (save-current-buffer | 859 (with-current-buffer standard-output |
857 (set-buffer standard-output) | |
858 (if (> (count-lines (point-min) (point-max)) 10) | 860 (if (> (count-lines (point-min) (point-max)) 10) |
859 (progn | 861 (progn |
860 ;; Note that setting the syntax table like below | 862 ;; Note that setting the syntax table like below |
861 ;; makes forward-sexp move over a `'s' at the end | 863 ;; makes forward-sexp move over a `'s' at the end |
862 ;; of a symbol. | 864 ;; of a symbol. |
871 (insert "\n\nValue:")))))) | 873 (insert "\n\nValue:")))))) |
872 (princ "Documentation:") | 874 (princ "Documentation:") |
873 (terpri) | 875 (terpri) |
874 (let ((doc (documentation-property variable 'variable-documentation))) | 876 (let ((doc (documentation-property variable 'variable-documentation))) |
875 (princ (or doc "not documented as a variable."))) | 877 (princ (or doc "not documented as a variable."))) |
876 (help-setup-xref (list #'describe-variable variable) (interactive-p)) | 878 (help-setup-xref (list #'describe-variable variable (current-buffer)) |
877 | 879 (interactive-p)) |
880 | |
878 ;; Make a link to customize if this variable can be customized. | 881 ;; Make a link to customize if this variable can be customized. |
879 ;; Note, it is not reliable to test only for a custom-type property | 882 ;; Note, it is not reliable to test only for a custom-type property |
880 ;; because those are only present after the var's definition | 883 ;; because those are only present after the var's definition |
881 ;; has been loaded. | 884 ;; has been loaded. |
882 (if (or (get variable 'custom-type) ; after defcustom | 885 (if (or (get variable 'custom-type) ; after defcustom |
886 (terpri) | 889 (terpri) |
887 (terpri) | 890 (terpri) |
888 (princ (concat "You can " customize-label " this variable.")) | 891 (princ (concat "You can " customize-label " this variable.")) |
889 (with-current-buffer "*Help*" | 892 (with-current-buffer "*Help*" |
890 (save-excursion | 893 (save-excursion |
891 (re-search-backward | 894 (re-search-backward |
892 (concat "\\(" customize-label "\\)") nil t) | 895 (concat "\\(" customize-label "\\)") nil t) |
893 (help-xref-button 1 (lambda (v) | 896 (help-xref-button 1 (lambda (v) |
894 (if help-xref-stack | 897 (if help-xref-stack |
895 (pop help-xref-stack)) | 898 (pop help-xref-stack)) |
896 (customize-variable v)) | 899 (customize-variable v)) |
917 | 920 |
918 (print-help-return-message) | 921 (print-help-return-message) |
919 (save-excursion | 922 (save-excursion |
920 (set-buffer standard-output) | 923 (set-buffer standard-output) |
921 ;; Return the text we displayed. | 924 ;; Return the text we displayed. |
922 (buffer-string)))) | 925 (buffer-string))))))) |
923 (message "You did not specify a variable"))) | |
924 | 926 |
925 (defun describe-bindings (&optional prefix buffer) | 927 (defun describe-bindings (&optional prefix buffer) |
926 "Show a list of all defined keys, and their definitions. | 928 "Show a list of all defined keys, and their definitions. |
927 We put that list in a buffer, and display the buffer. | 929 We put that list in a buffer, and display the buffer. |
928 | 930 |
1199 "mouse-2, RET: describe this function")) | 1201 "mouse-2, RET: describe this function")) |
1200 ((facep sym) | 1202 ((facep sym) |
1201 (help-xref-button | 1203 (help-xref-button |
1202 7 #'describe-face sym))))))) | 1204 7 #'describe-face sym))))))) |
1203 ;; An obvious case of a key substitution: | 1205 ;; An obvious case of a key substitution: |
1204 (save-excursion | 1206 (save-excursion |
1205 (while (re-search-forward | 1207 (while (re-search-forward |
1206 ;; Assume command name is only word characters | 1208 ;; Assume command name is only word characters |
1207 ;; and dashes to get things like `use M-x foo.'. | 1209 ;; and dashes to get things like `use M-x foo.'. |
1208 "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) | 1210 "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) |
1209 (let ((sym (intern-soft (match-string 1)))) | 1211 (let ((sym (intern-soft (match-string 1)))) |
1215 (save-excursion | 1217 (save-excursion |
1216 ;; Make sure to find the first keymap. | 1218 ;; Make sure to find the first keymap. |
1217 (goto-char (point-min)) | 1219 (goto-char (point-min)) |
1218 ;; Find a header and the column at which the command | 1220 ;; Find a header and the column at which the command |
1219 ;; name will be found. | 1221 ;; name will be found. |
1220 (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" | 1222 (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" |
1221 nil t) | 1223 nil t) |
1222 (let ((col (- (match-end 1) (match-beginning 1)))) | 1224 (let ((col (- (match-end 1) (match-beginning 1)))) |
1223 (while | 1225 (while |
1224 ;; Ignore single blank lines in table, but not | 1226 ;; Ignore single blank lines in table, but not |
1225 ;; double ones, which should terminate it. | 1227 ;; double ones, which should terminate it. |
1230 (skip-chars-backward "^\t\n") | 1232 (skip-chars-backward "^\t\n") |
1231 (if (and (>= (current-column) col) | 1233 (if (and (>= (current-column) col) |
1232 (looking-at "\\(\\sw\\|-\\)+$")) | 1234 (looking-at "\\(\\sw\\|-\\)+$")) |
1233 (let ((sym (intern-soft (match-string 0)))) | 1235 (let ((sym (intern-soft (match-string 0)))) |
1234 (if (fboundp sym) | 1236 (if (fboundp sym) |
1235 (help-xref-button | 1237 (help-xref-button |
1236 0 #'describe-function sym | 1238 0 #'describe-function sym |
1237 "mouse-2, RET: describe this function")))) | 1239 "mouse-2, RET: describe this function")))) |
1238 (zerop (forward-line))))))))) | 1240 (zerop (forward-line))))))))) |
1239 (set-syntax-table stab)) | 1241 (set-syntax-table stab)) |
1240 ;; Make a back-reference in this buffer if appropriate. | 1242 ;; Make a back-reference in this buffer if appropriate. |
1425 (goto-char (point-max))))))) | 1427 (goto-char (point-max))))))) |
1426 | 1428 |
1427 | 1429 |
1428 ;;; Automatic resizing of temporary buffers. | 1430 ;;; Automatic resizing of temporary buffers. |
1429 | 1431 |
1430 (defcustom temp-buffer-resize-mode nil | |
1431 "Non-nil means resize windows displaying temporary buffers. | |
1432 This makes the window the right height for its contents, but never | |
1433 more than `temp-buffer-max-height' nor less than `window-min-height'. | |
1434 This applies to `help', `apropos' and `completion' buffers, and some others. | |
1435 | |
1436 Setting this variable directly does not take effect; | |
1437 use either \\[customize] or the function `temp-buffer-resize-mode'." | |
1438 :get (lambda (symbol) | |
1439 (and (memq 'resize-temp-buffer-window temp-buffer-show-hook) t)) | |
1440 :set (lambda (symbol value) | |
1441 (temp-buffer-resize-mode (if value 1 -1))) | |
1442 :initialize 'custom-initialize-default | |
1443 :type 'boolean | |
1444 :group 'help | |
1445 :version "20.4") | |
1446 | |
1447 (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) | 1432 (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) |
1448 "*Maximum height of a window displaying a temporary buffer. | 1433 "*Maximum height of a window displaying a temporary buffer. |
1449 This is the maximum height (in text lines) which `resize-temp-buffer-window' | 1434 This is the maximum height (in text lines) which `resize-temp-buffer-window' |
1450 will give to a window displaying a temporary buffer. | 1435 will give to a window displaying a temporary buffer. |
1451 It can also be a function which will be called with the object corresponding | 1436 It can also be a function which will be called with the object corresponding |
1453 positive number." | 1438 positive number." |
1454 :type '(choice integer function) | 1439 :type '(choice integer function) |
1455 :group 'help | 1440 :group 'help |
1456 :version "20.4") | 1441 :version "20.4") |
1457 | 1442 |
1458 (defun temp-buffer-resize-mode (arg) | 1443 (define-minor-mode temp-buffer-resize-mode |
1459 "Toggle the mode which that makes windows smaller for temporary buffers. | 1444 "Toggle the mode which makes windows smaller for temporary buffers. |
1460 With prefix argument ARG, turn the resizing of windows displaying temporary | 1445 With prefix argument ARG, turn the resizing of windows displaying temporary |
1461 buffers on if ARG is positive or off otherwise. | 1446 buffers on if ARG is positive or off otherwise. |
1462 See the documentation of the variable `temp-buffer-resize-mode' for | 1447 This makes the window the right height for its contents, but never |
1463 more information." | 1448 more than `temp-buffer-max-height' nor less than `window-min-height'. |
1464 (interactive "P") | 1449 This applies to `help', `apropos' and `completion' buffers, and some others." |
1465 (let ((turn-it-on | 1450 nil nil nil :global t :group 'help |
1466 (if (null arg) | 1451 (if temp-buffer-resize-mode |
1467 (not (memq 'resize-temp-buffer-window temp-buffer-show-hook)) | 1452 ;; `help-mode-maybe' may add a `back' button and thus increase the |
1468 (> (prefix-numeric-value arg) 0)))) | 1453 ;; text size, so `resize-temp-buffer-window' must be run *after* it. |
1469 (if turn-it-on | 1454 (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) |
1470 (progn | 1455 (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))) |
1471 ;; `help-mode-maybe' may add a `back' button and thus increase the | |
1472 ;; text size, so `resize-temp-buffer-window' must be run *after* it. | |
1473 (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) | |
1474 (setq temp-buffer-resize-mode t)) | |
1475 (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window) | |
1476 (setq temp-buffer-resize-mode nil)))) | |
1477 | 1456 |
1478 (defun resize-temp-buffer-window () | 1457 (defun resize-temp-buffer-window () |
1479 "Resize the current window to fit its contents. | 1458 "Resize the current window to fit its contents. |
1480 Will not make it higher than `temp-buffer-max-height' nor smaller than | 1459 Will not make it higher than `temp-buffer-max-height' nor smaller than |
1481 `window-min-height'. Do nothing if it is the only window on its frame, if it | 1460 `window-min-height'. Do nothing if it is the only window on its frame, if it |