Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 405dd6d1825b
children 90d73dddcdc4
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Synched up with: FSF 19.30. 25 ;;; Synched up with: FSF 19.30.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; This file is dumped with XEmacs. 29 ;; This file is dumped with XEmacs.
30 30
31 ;; This code implements XEmacs's on-line help system, the one invoked by 31 ;; This code implements XEmacs's on-line help system, the one invoked by
32 ;;`M-x help-for-help'. 32 ;;`M-x help-for-help'.
33 33
149 ; probably excluding words without dashes in them unless enclosed 149 ; probably excluding words without dashes in them unless enclosed
150 ; in quotes, so that common words like "list" and "point" don't 150 ; in quotes, so that common words like "list" and "point" don't
151 ; become hyperlinks. 151 ; become hyperlinks.
152 ; -- we should *not* use font-lock keywords like below. Instead we 152 ; -- we should *not* use font-lock keywords like below. Instead we
153 ; should add the font-lock stuff ourselves during the scanning phase, 153 ; should add the font-lock stuff ourselves during the scanning phase,
154 ; if font-lock is enabled in this buffer. 154 ; if font-lock is enabled in this buffer.
155 155
156 ;(defun help-follow-reference (event extent user-data) 156 ;(defun help-follow-reference (event extent user-data)
157 ; (let ((symbol (intern-soft (extent-string extent)))) 157 ; (let ((symbol (intern-soft (extent-string extent))))
158 ; (cond ((and symbol (fboundp symbol)) 158 ; (cond ((and symbol (fboundp symbol))
159 ; (describe-function symbol)) 159 ; (describe-function symbol))
240 "Move point to the previous quoted symbol." 240 "Move point to the previous quoted symbol."
241 (interactive) 241 (interactive)
242 (search-backward-regexp "^\\w+:" nil t)) 242 (search-backward-regexp "^\\w+:" nil t))
243 243
244 (defun help-mode-bury () 244 (defun help-mode-bury ()
245 "Buries the buffer, possibly restoring the previous window configuration." 245 "Bury the help buffer, possibly restoring the previous window configuration."
246 (interactive) 246 (interactive)
247 (help-mode-quit t)) 247 (help-mode-quit t))
248 248
249 (defun help-mode-quit (&optional bury) 249 (defun help-mode-quit (&optional bury)
250 "Exits from help mode, possibly restoring the previous window configuration. 250 "Exit from help mode, possibly restoring the previous window configuration.
251 If the optional argument BURY is non-nil, the help buffer is buried, 251 If the optional argument BURY is non-nil, the help buffer is buried,
252 otherwise it is killed." 252 otherwise it is killed."
253 (interactive) 253 (interactive)
254 (let ((buf (current-buffer))) 254 (let ((buf (current-buffer)))
255 (cond ((frame-property (selected-frame) 'help-window-config) 255 (cond ((frame-property (selected-frame) 'help-window-config)
364 364
365 (defun describe-key-briefly (key) 365 (defun describe-key-briefly (key)
366 "Print the name of the function KEY invokes. KEY is a string." 366 "Print the name of the function KEY invokes. KEY is a string."
367 (interactive "kDescribe key briefly: ") 367 (interactive "kDescribe key briefly: ")
368 (let (defn menup) 368 (let (defn menup)
369 (setq defn (key-or-menu-binding key 'menup)) 369 (setq defn (key-or-menu-binding key 'menup))
370 (if (or (null defn) (integerp defn)) 370 (if (or (null defn) (integerp defn))
371 (message "%s is undefined" (key-description key)) 371 (message "%s is undefined" (key-description key))
372 ;; If it's a keyboard macro which trivially invokes another command, 372 ;; If it's a keyboard macro which trivially invokes another command,
373 ;; document that instead. 373 ;; document that instead.
374 (if (or (stringp defn) (vectorp defn)) 374 (if (or (stringp defn) (vectorp defn))
632 If the optional argument PREFIX is supplied, only commands which 632 If the optional argument PREFIX is supplied, only commands which
633 start with that sequence of keys are described. 633 start with that sequence of keys are described.
634 If the second argument (prefix arg, interactively) is non-null 634 If the second argument (prefix arg, interactively) is non-null
635 then only the mouse bindings are displayed." 635 then only the mouse bindings are displayed."
636 (interactive (list nil current-prefix-arg)) 636 (interactive (list nil current-prefix-arg))
637 (with-displaying-help-buffer (format "bindings for %s" major-mode) 637 (let (buf)
638 (describe-bindings-1 prefix mouse-only-p))) 638 (with-displaying-help-buffer (format "bindings for %s" major-mode)
639 (setq buf (describe-bindings-1 prefix mouse-only-p)))
640 buf))
639 641
640 (defun describe-bindings-1 (&optional prefix mouse-only-p) 642 (defun describe-bindings-1 (&optional prefix mouse-only-p)
641 (let ((heading (if mouse-only-p 643 (let ((heading (if mouse-only-p
642 (gettext "button binding\n------ -------\n") 644 (gettext "button binding\n------ -------\n")
643 (gettext "key binding\n--- -------\n"))) 645 (gettext "key binding\n--- -------\n")))
669 nil shadow prefix mouse-only-p) 671 nil shadow prefix mouse-only-p)
670 (when (and prefix function-key-map (not mouse-only-p)) 672 (when (and prefix function-key-map (not mouse-only-p))
671 (insert "\nFunction key map translations:\n" heading) 673 (insert "\nFunction key map translations:\n" heading)
672 (describe-bindings-internal function-key-map nil nil 674 (describe-bindings-internal function-key-map nil nil
673 prefix mouse-only-p)) 675 prefix mouse-only-p))
674 (set-buffer buffer))) 676 (set-buffer buffer)
677 standard-output))
675 678
676 (defun describe-prefix-bindings () 679 (defun describe-prefix-bindings ()
677 "Describe the bindings of the prefix used to reach this command. 680 "Describe the bindings of the prefix used to reach this command.
678 The prefix described consists of all but the last event 681 The prefix described consists of all but the last event
679 of the key sequence that ran this command." 682 of the key sequence that ran this command."
689 (princ "Key bindings starting with ") 692 (princ "Key bindings starting with ")
690 (princ (key-description prefix)) 693 (princ (key-description prefix))
691 (princ ":\n\n") 694 (princ ":\n\n")
692 (describe-bindings-1 prefix nil)))) 695 (describe-bindings-1 prefix nil))))
693 696
694 ;; Make C-h after a prefix, when not specifically bound, 697 ;; Make C-h after a prefix, when not specifically bound,
695 ;; run describe-prefix-bindings. 698 ;; run describe-prefix-bindings.
696 (setq prefix-help-command 'describe-prefix-bindings) 699 (setq prefix-help-command 'describe-prefix-bindings)
697 700
698 (defun describe-installation () 701 (defun describe-installation ()
699 "Display a buffer showing information about this XEmacs was compiled." 702 "Display a buffer showing information about this XEmacs was compiled."
965 ;(gettext "an autoloaded Lisp macro") 968 ;(gettext "an autoloaded Lisp macro")
966 ;(gettext "an interactive autoloaded Lisp macro") 969 ;(gettext "an interactive autoloaded Lisp macro")
967 970
968 ;; taken out of `describe-function-1' 971 ;; taken out of `describe-function-1'
969 (defun function-arglist (function) 972 (defun function-arglist (function)
970 "Returns a string giving the argument list of FUNCTION. 973 "Return a string giving the argument list of FUNCTION.
971 For example: 974 For example:
972 975
973 (function-arglist 'function-arglist) 976 (function-arglist 'function-arglist)
974 => (function-arglist FUNCTION) 977 => (function-arglist FUNCTION)
975 978
997 t)) 1000 t))
998 ((stringp arglist) 1001 ((stringp arglist)
999 (format "(%s %s)" function arglist))))) 1002 (format "(%s %s)" function arglist)))))
1000 1003
1001 (defun function-documentation (function &optional strip-arglist) 1004 (defun function-documentation (function &optional strip-arglist)
1002 "Returns a string giving the documentation for FUNCTION if any. 1005 "Return a string giving the documentation for FUNCTION, if any.
1003 If the optional argument STRIP-ARGLIST is non-nil remove the arglist 1006 If the optional argument STRIP-ARGLIST is non-nil, remove the arglist
1004 part of the documentation of internal subroutines." 1007 part of the documentation of internal subroutines."
1005 (let ((doc (condition-case nil 1008 (let ((doc (condition-case nil
1006 (or (documentation function) 1009 (or (documentation function)
1007 (gettext "not documented")) 1010 (gettext "not documented"))
1008 (void-function "")))) 1011 (void-function ""))))
1019 (while (and (symbolp def) (fboundp def)) 1022 (while (and (symbolp def) (fboundp def))
1020 (when (not (eq def function)) 1023 (when (not (eq def function))
1021 (setq aliases 1024 (setq aliases
1022 (if aliases 1025 (if aliases
1023 ;; I18N3 Need gettext due to concat 1026 ;; I18N3 Need gettext due to concat
1024 (concat aliases 1027 (concat aliases
1025 (format 1028 (format
1026 "\n which is an alias for `%s', " 1029 "\n which is an alias for `%s', "
1027 (symbol-name def))) 1030 (symbol-name def)))
1028 (format "an alias for `%s', " (symbol-name def))))) 1031 (format "an alias for `%s', " (symbol-name def)))))
1029 (setq def (symbol-function def))) 1032 (setq def (symbol-function def)))
1178 (default-console "a built-in default console-local variable") 1181 (default-console "a built-in default console-local variable")
1179 (t 1182 (t
1180 (if type "an unknown type of built-in variable?" 1183 (if type "an unknown type of built-in variable?"
1181 "a variable declared in Lisp"))))) 1184 "a variable declared in Lisp")))))
1182 1185
1183 (defcustom help-pretty-print-limit 100
1184 "Limit on length of lists above which pretty-printing of values is stopped.
1185 Setting this to 0 disables pretty-printing."
1186 :type 'integer
1187 :group 'help)
1188
1189 (defun help-maybe-pretty-print-value (object)
1190 "Pretty-print OBJECT, unless it is a long list.
1191 OBJECT is printed in the current buffer. Unless it is a list with
1192 more than `help-pretty-print-limit' elements, it is pretty-printed.
1193
1194 Uses `pp-internal' if defined, otherwise `cl-prettyprint'"
1195 (princ
1196 (let ((valstr
1197 (if (and (or (listp object) (vectorp object))
1198 (< (length object)
1199 help-pretty-print-limit))
1200 (with-output-to-string
1201 (with-syntax-table emacs-lisp-mode-syntax-table
1202 ;; print `#<...>' values better
1203 (modify-syntax-entry ?< "(>")
1204 (modify-syntax-entry ?> ")<")
1205 (let ((indent-line-function 'lisp-indent-line))
1206 (if (fboundp 'pp-internal)
1207 (progn
1208 (pp-internal object "\n")
1209 (terpri))
1210 (cl-prettyprint object)))))
1211 (format "\n%S\n" object))))
1212
1213 (if (string-match "^\n[^\n]*\n$" valstr)
1214 (substring valstr 1)
1215 valstr))))
1216
1217 (defun describe-variable (variable) 1186 (defun describe-variable (variable)
1218 "Display the full documentation of VARIABLE (a symbol)." 1187 "Display the full documentation of VARIABLE (a symbol)."
1219 (interactive 1188 (interactive
1220 (let* ((v (variable-at-point)) 1189 (let* ((v (variable-at-point))
1221 (val (let ((enable-recursive-minibuffers t)) 1190 (val (let ((enable-recursive-minibuffers t))
1222 (completing-read 1191 (completing-read
1223 (if v 1192 (if v
1224 (format "Describe variable (default %s): " v) 1193 (format "Describe variable (default %s): " v)
1233 (while (variable-alias variable) 1202 (while (variable-alias variable)
1234 (let ((newvar (variable-alias variable))) 1203 (let ((newvar (variable-alias variable)))
1235 (if aliases 1204 (if aliases
1236 ;; I18N3 Need gettext due to concat 1205 ;; I18N3 Need gettext due to concat
1237 (setq aliases 1206 (setq aliases
1238 (concat aliases 1207 (concat aliases
1239 (format "\n which is an alias for `%s'," 1208 (format "\n which is an alias for `%s',"
1240 (symbol-name newvar)))) 1209 (symbol-name newvar))))
1241 (setq aliases 1210 (setq aliases
1242 (format "an alias for `%s'," 1211 (format "an alias for `%s',"
1243 (symbol-name newvar)))) 1212 (symbol-name newvar))))
1250 (if file-name 1219 (if file-name
1251 (princ (format " -- loaded from \"%s\"\n" file-name)))) 1220 (princ (format " -- loaded from \"%s\"\n" file-name))))
1252 (princ "\nValue: ") 1221 (princ "\nValue: ")
1253 (if (not (boundp variable)) 1222 (if (not (boundp variable))
1254 (princ "void\n") 1223 (princ "void\n")
1255 (help-maybe-pretty-print-value (symbol-value variable))) 1224 (prin1 (symbol-value variable))
1225 (terpri))
1256 (terpri) 1226 (terpri)
1257 (cond ((local-variable-p variable (current-buffer)) 1227 (cond ((local-variable-p variable (current-buffer))
1258 (let* ((void (cons nil nil)) 1228 (let* ((void (cons nil nil))
1259 (def (condition-case nil 1229 (def (condition-case nil
1260 (default-value variable) 1230 (default-value variable)
1268 (not (eq (symbol-value variable) def))) 1238 (not (eq (symbol-value variable) def)))
1269 ;; #### I18N3 doesn't localize properly! 1239 ;; #### I18N3 doesn't localize properly!
1270 (progn (princ "Default-value: ") 1240 (progn (princ "Default-value: ")
1271 (if (eq def void) 1241 (if (eq def void)
1272 (princ "void\n") 1242 (princ "void\n")
1273 (help-maybe-pretty-print-value def)) 1243 (prin1 def)
1244 (terpri))
1274 (terpri))))) 1245 (terpri)))))
1275 ((local-variable-p variable (current-buffer) t) 1246 ((local-variable-p variable (current-buffer) t)
1276 (princ "Setting it would make its value buffer-local.\n\n")))) 1247 (princ "Setting it would make its value buffer-local.\n\n"))))
1277 (princ "Documentation:") 1248 (princ "Documentation:")
1278 (terpri) 1249 (terpri)
1309 Argument is a command definition, usually a symbol with a function definition. 1280 Argument is a command definition, usually a symbol with a function definition.
1310 When run interactively, it defaults to any function found by 1281 When run interactively, it defaults to any function found by
1311 `function-at-point'." 1282 `function-at-point'."
1312 (interactive 1283 (interactive
1313 (let ((fn (function-at-point)) 1284 (let ((fn (function-at-point))
1314 (enable-recursive-minibuffers t) 1285 (enable-recursive-minibuffers t)
1315 val) 1286 val)
1316 (setq val (read-command 1287 (setq val (read-command
1317 (if fn (format "Where is command (default %s): " fn) 1288 (if fn (format "Where is command (default %s): " fn)
1318 "Where is command: "))) 1289 "Where is command: ")))
1319 (list (if (equal (symbol-name val) "") 1290 (list (if (equal (symbol-name val) "")