Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 5923:61d7d7bcbe76 cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged heads after pull -u
author Henry Thompson <ht@markup.co.uk>
date Thu, 05 Feb 2015 17:19:05 +0000
parents cf0201de66df
children
comparison
equal deleted inserted replaced
5921:68639fb08af8 5923:61d7d7bcbe76
1 ;; help.el --- help commands for XEmacs. 1 ;; help.el --- help commands for XEmacs.
2 2
3 ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1992-4, 1997, 2014 Free Software Foundation, Inc.
4 ;; Copyright (C) 2001, 2002, 2003, 2010 Ben Wing. 4 ;; Copyright (C) 2001, 2002, 2003, 2010 Ben Wing.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: help, internal, dumped 7 ;; Keywords: help, internal, dumped
8 8
53 (set-keymap-name map 'help-map) 53 (set-keymap-name map 'help-map)
54 (set-keymap-prompt 54 (set-keymap-prompt
55 map (gettext "(Type ? for further options)")) 55 map (gettext "(Type ? for further options)"))
56 map) 56 map)
57 "Keymap for characters following the Help key.") 57 "Keymap for characters following the Help key.")
58
59 (defvar help-mode-link-positions nil)
60 (make-variable-buffer-local 'help-mode-link-positions)
58 61
59 ;; global-map definitions moved to keydefs.el 62 ;; global-map definitions moved to keydefs.el
60 (fset 'help-command help-map) 63 (fset 'help-command help-map)
61 64
62 (define-key help-map (vector help-char) 'help-for-help) 65 (define-key help-map (vector help-char) 'help-for-help)
140 (define-derived-mode help-mode view-major-mode "Help" 143 (define-derived-mode help-mode view-major-mode "Help"
141 "Major mode for viewing help text. 144 "Major mode for viewing help text.
142 Entry to this mode runs the normal hook `help-mode-hook'. 145 Entry to this mode runs the normal hook `help-mode-hook'.
143 Commands: 146 Commands:
144 \\{help-mode-map}" 147 \\{help-mode-map}"
148 (help-mode-get-link-positions)
145 ) 149 )
146 150
147 (define-key help-mode-map "q" 'help-mode-quit) 151 (define-key help-mode-map "q" 'help-mode-quit)
148 (define-key help-mode-map "Q" 'help-mode-bury) 152 (define-key help-mode-map "Q" 'help-mode-bury)
149 (define-key help-mode-map "f" 'find-function-at-point) 153 (define-key help-mode-map "f" 'find-function-at-point)
150 (define-key help-mode-map "d" 'describe-function-at-point) 154 (define-key help-mode-map "d" 'describe-function-at-point)
151 (define-key help-mode-map "v" 'describe-variable-at-point) 155 (define-key help-mode-map "v" 'describe-variable-at-point)
152 (define-key help-mode-map "i" 'Info-elisp-ref) 156 (define-key help-mode-map "i" 'Info-elisp-ref)
153 (define-key help-mode-map "c" 'customize-variable) 157 (define-key help-mode-map "c" 'customize-variable)
154 (define-key help-mode-map [tab] 'help-next-symbol) 158 (define-key help-mode-map [tab] 'help-next-symbol)
155 (define-key help-mode-map [(shift tab)] 'help-prev-symbol) 159 (define-key help-mode-map [iso-left-tab] 'help-prev-symbol)
156 (define-key help-mode-map [return] 'help-find-source-or-scroll-up) 160 (define-key help-mode-map [backtab] 'help-prev-symbol)
157 (define-key help-mode-map [button2] 'help-mouse-find-source-or-track) 161 (define-key help-mode-map [return] 'help-activate-function-or-scroll-up)
158 (define-key help-mode-map "n" 'help-next-section) 162 (define-key help-mode-map "n" 'help-next-section)
159 (define-key help-mode-map "p" 'help-prev-section) 163 (define-key help-mode-map "p" 'help-prev-section)
160 164
161 (define-derived-mode temp-buffer-mode view-major-mode "Temp" 165 (define-derived-mode temp-buffer-mode view-major-mode "Temp"
162 "Major mode for viewing temporary buffers. 166 "Major mode for viewing temporary buffers.
183 (let ((symb (variable-at-point))) 187 (let ((symb (variable-at-point)))
184 (when symb 188 (when symb
185 (describe-variable symb)))) 189 (describe-variable symb))))
186 190
187 (defun help-next-symbol () 191 (defun help-next-symbol ()
188 "Move point to the next quoted symbol." 192 "Move point to the next link."
189 (interactive) 193 (interactive)
190 (search-forward "`" nil t)) 194 (let ((p (point))
195 (positions help-mode-link-positions)
196 (firstpos (car help-mode-link-positions)))
197 (while (and positions (>= p (car positions)))
198 (setq positions (cdr positions)))
199 (if (or positions firstpos)
200 (goto-char (or (car positions) firstpos)))))
191 201
192 (defun help-prev-symbol () 202 (defun help-prev-symbol ()
193 "Move point to the previous quoted symbol." 203 "Move point to the previous link."
194 (interactive) 204 (interactive)
195 (search-backward "'" nil t)) 205 (let* ((p (point))
206 (positions (reverse help-mode-link-positions))
207 (lastpos (car positions)))
208 (while (and positions (<= p (car positions)))
209 (setq positions (cdr positions)))
210 (if (or positions lastpos)
211 (goto-char (or (car positions) lastpos)))))
196 212
197 (defun help-next-section () 213 (defun help-next-section ()
198 "Move point to the next quoted symbol." 214 "Move point to the next quoted symbol."
199 (interactive) 215 (interactive)
200 (search-forward-regexp "^\\w+:" nil t)) 216 (search-forward-regexp "^\\w+:" nil t))
224 (kill-buffer buf)))) 240 (kill-buffer buf))))
225 241
226 (defun help-quit () 242 (defun help-quit ()
227 (interactive) 243 (interactive)
228 nil) 244 nil)
245
246 (defun help-mode-get-link-positions ()
247 "Get the positions of the links in the help buffer"
248 (let ((el (extent-list nil (point-min) (point-max) nil 'activate-function))
249 (positions nil))
250 (while el
251 (setq positions (append positions (list (extent-start-position (car el)))))
252 (setq el (cdr el)))
253 (setq help-mode-link-positions positions)))
254
229 255
230 (define-obsolete-function-alias 'deprecated-help-command 'help-for-help) 256 (define-obsolete-function-alias 'deprecated-help-command 'help-for-help)
231 257
232 ;;(define-key global-map 'backspace 'deprecated-help-command) 258 ;;(define-key global-map 'backspace 'deprecated-help-command)
233 259
1281 1307
1282 (defun help-symbol-run-function-1 (ev ex fun) 1308 (defun help-symbol-run-function-1 (ev ex fun)
1283 (let ((help-sticky-window 1309 (let ((help-sticky-window
1284 ;; if we were called from a help buffer, make sure the new help 1310 ;; if we were called from a help buffer, make sure the new help
1285 ;; goes in the same window. 1311 ;; goes in the same window.
1286 (if (and (event-buffer ev) 1312 (if (and ev
1313 (event-buffer ev)
1287 (symbol-value-in-buffer 'help-window-config 1314 (symbol-value-in-buffer 'help-window-config
1288 (event-buffer ev))) 1315 (event-buffer ev)))
1289 (event-window ev) 1316 (event-window ev)
1290 help-sticky-window))) 1317 (if ev help-sticky-window
1318 (get-buffer-window (current-buffer))))))
1291 (funcall fun (extent-property ex 'help-symbol)))) 1319 (funcall fun (extent-property ex 'help-symbol))))
1292 1320
1293 (defun help-symbol-run-function (fun) 1321 (defun help-symbol-run-function (fun)
1294 (let ((ex (extent-at-event last-popup-menu-event 'help-symbol))) 1322 (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
1295 (when ex 1323 (when ex
1443 (princ file-name) 1471 (princ file-name)
1444 (setq e (make-extent opoint (point standard-output) 1472 (setq e (make-extent opoint (point standard-output)
1445 standard-output)) 1473 standard-output))
1446 (set-extent-property e 'face 'hyper-apropos-hyperlink) 1474 (set-extent-property e 'face 'hyper-apropos-hyperlink)
1447 (set-extent-property e 'mouse-face 'highlight) 1475 (set-extent-property e 'mouse-face 'highlight)
1448 (set-extent-property e 'find-function-symbol function))) 1476 (set-extent-property e 'help-symbol function)
1477 (set-extent-property e 'activate-function #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'find-function)))))
1449 (princ "\"\n")) 1478 (princ "\"\n"))
1450 (if describe-function-show-arglist 1479 (if describe-function-show-arglist
1451 (let ((arglist (function-arglist function))) 1480 (let ((arglist (function-arglist function)))
1452 (when arglist 1481 (when arglist
1453 (require 'hyper-apropos) 1482 (require 'hyper-apropos)
1631 (default-console "a built-in default console-local variable") 1660 (default-console "a built-in default console-local variable")
1632 (t 1661 (t
1633 (if type "an unknown type of built-in variable?" 1662 (if type "an unknown type of built-in variable?"
1634 "a variable declared in Lisp"))))) 1663 "a variable declared in Lisp")))))
1635 1664
1665 (defun describe-variable-custom-version-info (variable)
1666 (let ((custom-version (get variable 'custom-version))
1667 (cpv (get variable 'custom-package-version))
1668 (output nil))
1669 (if custom-version
1670 (setq output
1671 (format "This variable was introduced, or its default value was changed, in\nversion %s of XEmacs.\n"
1672 custom-version))
1673 (when cpv
1674 (let* ((package (car-safe cpv))
1675 (version (if (listp (cdr-safe cpv))
1676 (car (cdr-safe cpv))
1677 (cdr-safe cpv)))
1678 (pkg-versions (assq package customize-package-emacs-version-alist))
1679 (emacsv (cdr (assoc version pkg-versions))))
1680 (if (and package version)
1681 (setq output
1682 (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
1683 (if emacsv
1684 (format " that is part of XEmacs %s" emacsv))
1685 ".\n")
1686 version package))))))
1687 output))
1688
1636 (defun describe-variable (variable) 1689 (defun describe-variable (variable)
1637 "Display the full documentation of VARIABLE (a symbol)." 1690 "Display the full documentation of VARIABLE (a symbol)."
1638 (interactive 1691 (interactive
1639 (let* ((v (variable-at-point)) 1692 (let* ((v (variable-at-point))
1640 (val (let ((enable-recursive-minibuffers t)) 1693 (val (let ((enable-recursive-minibuffers t))
1682 (princ file-name) 1735 (princ file-name)
1683 (setq e (make-extent opoint (point standard-output) 1736 (setq e (make-extent opoint (point standard-output)
1684 standard-output)) 1737 standard-output))
1685 (set-extent-property e 'face 'hyper-apropos-hyperlink) 1738 (set-extent-property e 'face 'hyper-apropos-hyperlink)
1686 (set-extent-property e 'mouse-face 'highlight) 1739 (set-extent-property e 'mouse-face 'highlight)
1687 (set-extent-property e 'find-variable-symbol variable)) 1740 (set-extent-property e 'help-symbol variable)
1741 (set-extent-property e 'activate-function #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'find-variable))))
1688 (princ"\"\n"))) 1742 (princ"\"\n")))
1689 (princ "\nValue: ") 1743 (princ "\nValue: ")
1690 (if (not (boundp variable)) 1744 (if (not (boundp variable))
1691 (Help-princ-face "void\n" 'hyper-apropos-documentation) 1745 (Help-princ-face "void\n" 'hyper-apropos-documentation)
1692 (Help-prin1-face (symbol-value variable) 1746 (Help-prin1-face (symbol-value variable)
1737 (setq newp (point standard-output)) 1791 (setq newp (point standard-output))
1738 (goto-char oldp standard-output) 1792 (goto-char oldp standard-output)
1739 (frob-help-extents standard-output) 1793 (frob-help-extents standard-output)
1740 (goto-char newp standard-output)) 1794 (goto-char newp standard-output))
1741 (princ "not documented as a variable.")))) 1795 (princ "not documented as a variable."))))
1796 ;; Make a link to customize if this variable can be customized.
1797 (when (custom-variable-p variable)
1798 (let ((customize-label "customize"))
1799 (terpri)
1800 (terpri)
1801 (princ (concat "You can " customize-label " this variable."))
1802 (with-current-buffer standard-output
1803 (save-excursion
1804 (re-search-backward
1805 (concat "\\(" customize-label "\\)") nil t)
1806 (let ((opoint (point standard-output))
1807 e)
1808 (require 'hyper-apropos)
1809 ;; (princ variable)
1810 (re-search-forward (concat "\\(" customize-label "\\)") nil t)
1811 (setq e (make-extent opoint (point standard-output)
1812 standard-output))
1813 (set-extent-property e 'face 'hyper-apropos-hyperlink)
1814 (set-extent-property e 'mouse-face 'highlight)
1815 (set-extent-property e 'help-symbol variable)
1816 (set-extent-property e 'activate-function #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'customize-variable)))))))
1817 ;; Note variable's version or package version
1818 (let ((output (describe-variable-custom-version-info variable)))
1819 (when output
1820 (terpri)
1821 (terpri)
1822 (princ output))))
1742 (terpri))) 1823 (terpri)))
1743 (format "variable `%s'" variable))) 1824 (format "variable `%s'" variable)))
1744 1825
1745 (defun sorted-key-descriptions (keys &optional separator) 1826 (defun sorted-key-descriptions (keys &optional separator)
1746 "Sort and separate the key descriptions for KEYS. 1827 "Sort and separate the key descriptions for KEYS.
1868 (let ((string (eval form))) 1949 (let ((string (eval form)))
1869 (if (stringp string) 1950 (if (stringp string)
1870 (with-displaying-help-buffer 1951 (with-displaying-help-buffer
1871 (insert string))))) 1952 (insert string)))))
1872 1953
1873 (defun help-find-source-or-scroll-up (&optional pos) 1954 (defun help-activate-function-or-scroll-up (&optional pos)
1874 "Follow any cross reference to source code; if none, scroll up. " 1955 "Follow any cross reference to source code; if none, scroll up. "
1875 (interactive "d") 1956 (interactive "d")
1876 (let ((e (extent-at pos nil 'find-function-symbol))) 1957 (let ((e (extent-at pos nil 'activate-function)))
1877 (if (and-fboundp 'find-function e) 1958 (if e
1878 (with-fboundp 'find-function 1959 (funcall (extent-property e 'activate-function) nil e)
1879 (find-function (extent-property e 'find-function-symbol))) 1960 (scroll-up 1))))
1880 (setq e (extent-at pos nil 'find-variable-symbol))
1881 (if (and-fboundp 'find-variable e)
1882 (with-fboundp 'find-variable
1883 (find-variable (extent-property e 'find-variable-symbol)))
1884 (scroll-up 1)))))
1885
1886 (defun help-mouse-find-source-or-track (event)
1887 "Follow any cross reference to source code under the mouse;
1888 if none, call mouse-track. "
1889 (interactive "e")
1890 (mouse-set-point event)
1891 (let ((e (extent-at (point) nil 'find-function-symbol)))
1892 (if (and-fboundp 'find-function e)
1893 (with-fboundp 'find-function
1894 (find-function (extent-property e 'find-function-symbol)))
1895 (setq e (extent-at (point) nil 'find-variable-symbol))
1896 (if (and-fboundp 'find-variable e)
1897 (with-fboundp 'find-variable
1898 (find-variable (extent-property e 'find-variable-symbol)))
1899 (mouse-track event)))))
1900 1961
1901 (define-minor-mode temp-buffer-resize-mode 1962 (define-minor-mode temp-buffer-resize-mode
1902 "Toggle the mode which makes windows smaller for temporary buffers. 1963 "Toggle the mode which makes windows smaller for temporary buffers.
1903 With prefix argument ARG, turn the resizing of windows displaying temporary 1964 With prefix argument ARG, turn the resizing of windows displaying temporary
1904 buffers on if ARG is positive or off otherwise. 1965 buffers on if ARG is positive or off otherwise.