Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 462:0784d089fdc9 r21-2-46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-46
author cvs
date Mon, 13 Aug 2007 11:44:37 +0200
parents e7ef97881643
children 5aa1854ad537
comparison
equal deleted inserted replaced
461:120ed4009e51 462:0784d089fdc9
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 Free Software Foundation, Inc.
4 ;; Copyright (C) 2001 Ben Wing.
4 5
5 ;; Maintainer: FSF 6 ;; Maintainer: FSF
6 ;; Keywords: help, internal, dumped 7 ;; Keywords: help, internal, dumped
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
262 (setq unread-command-event (character-to-event ?\C-h)) 263 (setq unread-command-event (character-to-event ?\C-h))
263 (help-for-help))) 264 (help-for-help)))
264 265
265 ;;(define-key global-map 'backspace 'deprecated-help-command) 266 ;;(define-key global-map 'backspace 'deprecated-help-command)
266 267
267 ;; This function has been moved to help-nomule.el and mule-help.el. 268 ;; help-with-tutorial moved to help-nomule.el and mule-help.el.
268 ;; TUTORIAL arg is XEmacs addition
269 ;(defun help-with-tutorial (&optional tutorial)
270 ; "Select the XEmacs learn-by-doing tutorial.
271 ;Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\"."
272 ; (interactive)
273 ; (if (null tutorial)
274 ; (setq tutorial "TUTORIAL"))
275 ; (let ((file (expand-file-name (concat "~/" tutorial))))
276 ; (delete-other-windows)
277 ; (if (get-file-buffer file)
278 ; (switch-to-buffer (get-file-buffer file))
279 ; (switch-to-buffer (create-file-buffer file))
280 ; (setq buffer-file-name file)
281 ; (setq default-directory (expand-file-name "~/"))
282 ; (setq buffer-auto-save-file-name nil)
283 ; (insert-file-contents (expand-file-name tutorial data-directory))
284 ; (goto-char (point-min))
285 ; (search-forward "\n<<")
286 ; (delete-region (point-at-bol) (point-at-eol))
287 ; (let ((n (- (window-height (selected-window))
288 ; (count-lines (point-min) (point))
289 ; 6)))
290 ; (if (< n 12)
291 ; (newline n)
292 ; ;; Some people get confused by the large gap.
293 ; (newline (/ n 2))
294 ; (insert "[Middle of page left blank for didactic purposes. "
295 ; "Text continues below]")
296 ; (newline (- n (/ n 2)))))
297 ; (goto-char (point-min))
298 ; (set-buffer-modified-p nil))))
299 269
300 ;; used by describe-key, describe-key-briefly, insert-key-binding, etc. 270 ;; used by describe-key, describe-key-briefly, insert-key-binding, etc.
301
302 (defun key-or-menu-binding (key &optional menu-flag) 271 (defun key-or-menu-binding (key &optional menu-flag)
303 "Return the command invoked by KEY. 272 "Return the command invoked by KEY.
304 Like `key-binding', but handles menu events and toolbar presses correctly. 273 Like `key-binding', but handles menu events and toolbar presses correctly.
305 KEY is any value returned by `next-command-event'. 274 KEY is any value returned by `next-command-event'.
306 MENU-FLAG is a symbol that should be set to t if KEY is a menu event, 275 MENU-FLAG is a symbol that should be set to t if KEY is a menu event,
618 (format "%s mode" mode-name))) 587 (format "%s mode" mode-name)))
619 588
620 ;; So keyboard macro definitions are documented correctly 589 ;; So keyboard macro definitions are documented correctly
621 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) 590 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
622 591
592 ;; view a read-only file intelligently
593 (defun Help-find-file (file)
594 (if (fboundp 'view-file)
595 (view-file file)
596 (find-file-read-only file)
597 (goto-char (point-min))))
598
623 (defun describe-distribution () 599 (defun describe-distribution ()
624 "Display info on how to obtain the latest version of XEmacs." 600 "Display info on how to obtain the latest version of XEmacs."
625 (interactive) 601 (interactive)
626 (find-file-read-only 602 (Help-find-file (locate-data-file "DISTRIB")))
627 (locate-data-file "DISTRIB")))
628 603
629 (defun describe-beta () 604 (defun describe-beta ()
630 "Display info on how to deal with Beta versions of XEmacs." 605 "Display info on how to deal with Beta versions of XEmacs."
631 (interactive) 606 (interactive)
632 (find-file-read-only 607 (Help-find-file (locate-data-file "BETA")))
633 (locate-data-file "BETA"))
634 (goto-char (point-min)))
635 608
636 (defun describe-copying () 609 (defun describe-copying ()
637 "Display info on how you may redistribute copies of XEmacs." 610 "Display info on how you may redistribute copies of XEmacs."
638 (interactive) 611 (interactive)
639 (find-file-read-only 612 (Help-find-file (locate-data-file "COPYING")))
640 (locate-data-file "COPYING"))
641 (goto-char (point-min)))
642 613
643 (defun describe-pointer () 614 (defun describe-pointer ()
644 "Show a list of all defined mouse buttons, and their definitions." 615 "Show a list of all defined mouse buttons, and their definitions."
645 (interactive) 616 (interactive)
646 (describe-bindings nil t)) 617 (describe-bindings nil t))
647 618
648 (defun describe-project () 619 (defun describe-project ()
649 "Display info on the GNU project." 620 "Display info on the GNU project."
650 (interactive) 621 (interactive)
651 (find-file-read-only 622 (Help-find-file (locate-data-file "GNU")))
652 (locate-data-file "GNU"))
653 (goto-char (point-min)))
654 623
655 (defun describe-no-warranty () 624 (defun describe-no-warranty ()
656 "Display info on all the kinds of warranty XEmacs does NOT have." 625 "Display info on all the kinds of warranty XEmacs does NOT have."
657 (interactive) 626 (interactive)
658 (describe-copying) 627 (describe-copying)
760 (error "No Installation information available."))) 729 (error "No Installation information available.")))
761 730
762 (defun view-emacs-news () 731 (defun view-emacs-news ()
763 "Display info on recent changes to XEmacs." 732 "Display info on recent changes to XEmacs."
764 (interactive) 733 (interactive)
765 (find-file (locate-data-file "NEWS"))) 734 (Help-find-file (locate-data-file "NEWS")))
766 735
767 (defun xemacs-www-page () 736 (defun xemacs-www-page ()
768 "Go to the XEmacs World Wide Web page." 737 "Go to the XEmacs World Wide Web page."
769 (interactive) 738 (interactive)
770 (if (fboundp 'browse-url) 739 (if (fboundp 'browse-url)
785 (interactive) 754 (interactive)
786 (save-window-excursion 755 (save-window-excursion
787 (info) 756 (info)
788 (Info-find-node "xemacs-faq" "Top")) 757 (Info-find-node "xemacs-faq" "Top"))
789 (switch-to-buffer "*info*")) 758 (switch-to-buffer "*info*"))
759
760 (defun view-sample-init-el ()
761 "Display the sample init.el file."
762 (interactive)
763 (Help-find-file (locate-data-file "sample.init.el")))
790 764
791 (defcustom view-lossage-key-count 100 765 (defcustom view-lossage-key-count 100
792 "*Number of keys `view-lossage' shows. 766 "*Number of keys `view-lossage' shows.
793 The maximum number of available keys is governed by `recent-keys-ring-size'." 767 The maximum number of available keys is governed by `recent-keys-ring-size'."
794 :type 'integer 768 :type 'integer
1122 ; t) 1096 ; t)
1123 ; ;; 1097 ; ;;
1124 ; ;; CLisp `:' keywords as references. 1098 ; ;; CLisp `:' keywords as references.
1125 ; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) 1099 ; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))
1126 1100
1101 ;; replacement for `princ' that puts the text in the specified face,
1102 ;; if possible
1103 (defun Help-princ-face (object face)
1104 (cond ((bufferp standard-output)
1105 (let ((opoint (point standard-output)))
1106 (princ object)
1107 (put-nonduplicable-text-property opoint (point standard-output)
1108 'face face standard-output)))
1109 ((markerp standard-output)
1110 (let ((buf (marker-buffer standard-output))
1111 (pos (marker-position standard-output)))
1112 (princ object)
1113 (put-nonduplicable-text-property
1114 pos (marker-position standard-output) 'face face buf)))
1115 (t princ object)))
1116
1117 ;; replacement for `prin1' that puts the text in the specified face,
1118 ;; if possible
1119 (defun Help-prin1-face (object face)
1120 (cond ((bufferp standard-output)
1121 (let ((opoint (point standard-output)))
1122 (prin1 object)
1123 (put-nonduplicable-text-property opoint (point standard-output)
1124 'face face standard-output)))
1125 ((markerp standard-output)
1126 (let ((buf (marker-buffer standard-output))
1127 (pos (marker-position standard-output)))
1128 (prin1 object)
1129 (put-nonduplicable-text-property
1130 pos (marker-position standard-output) 'face face buf)))
1131 (t prin1 object)))
1132
1127 (defvar help-symbol-regexp 1133 (defvar help-symbol-regexp
1128 (let ((sym-char "[+a-zA-Z0-9_:*]") 1134 (let ((sym-char "[+a-zA-Z0-9_:*]")
1129 (sym-char-no-dash "[-+a-zA-Z0-9_:*]")) 1135 (sym-char-no-dash "[-+a-zA-Z0-9_:*]"))
1130 (concat "\\(" 1136 (concat "\\("
1131 ;; a symbol with a - in it. 1137 ;; a symbol with a - in it.
1149 (let ((ex (extent-at-event last-popup-menu-event 'help-symbol))) 1155 (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
1150 (when ex 1156 (when ex
1151 (help-symbol-run-function-1 last-popup-menu-event ex fun)))) 1157 (help-symbol-run-function-1 last-popup-menu-event ex fun))))
1152 1158
1153 (defvar help-symbol-function-context-menu 1159 (defvar help-symbol-function-context-menu
1154 '("---" 1160 '(["View %_Documentation" (help-symbol-run-function 'describe-function)]
1155 ["View %_Documentation" (help-symbol-run-function 'describe-function)]
1156 ["Find %_Function Source" (help-symbol-run-function 'find-function)] 1161 ["Find %_Function Source" (help-symbol-run-function 'find-function)]
1162 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1157 )) 1163 ))
1158 1164
1159 (defvar help-symbol-variable-context-menu 1165 (defvar help-symbol-variable-context-menu
1160 '("---" 1166 '(["View %_Documentation" (help-symbol-run-function 'describe-variable)]
1161 ["View %_Documentation" (help-symbol-run-function 'describe-variable)]
1162 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] 1167 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
1168 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1163 )) 1169 ))
1164 1170
1165 (defvar help-symbol-function-and-variable-context-menu 1171 (defvar help-symbol-function-and-variable-context-menu
1166 '("---" 1172 '(["View Function %_Documentation" (help-symbol-run-function
1167 ["View Function %_Documentation" (help-symbol-run-function
1168 'describe-function)] 1173 'describe-function)]
1169 ["View Variable D%_ocumentation" (help-symbol-run-function 1174 ["View Variable D%_ocumentation" (help-symbol-run-function
1170 'describe-variable)] 1175 'describe-variable)]
1171 ["Find %_Function Source" (help-symbol-run-function 'find-function)] 1176 ["Find %_Function Source" (help-symbol-run-function 'find-function)]
1172 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)] 1177 ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
1178 ["Find %_Tag" (help-symbol-run-function 'find-tag)]
1173 )) 1179 ))
1174 1180
1175 (defun frob-help-extents (buffer) 1181 (defun frob-help-extents (buffer)
1176 ;; Look through BUFFER, starting at the buffer's point and continuing 1182 ;; Look through BUFFER, starting at the buffer's point and continuing
1177 ;; till end of file, and find documented functions and variables. 1183 ;; till end of file, and find documented functions and variables.
1178 ;; any such symbol found is tagged with an extent, that sets up these 1184 ;; any such symbol found is tagged with an extent, that sets up these
1179 ;; properties: 1185 ;; properties:
1180 ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over) 1186 ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over)
1181 ;; 2. help-symbol is the name of the symbol. 1187 ;; 2. help-symbol is the name of the symbol.
1182 ;; 3. context-menu is a list of context menu items, specific to whether 1188 ;; 3. face is 'font-lock-reference-face.
1189 ;; 4. context-menu is a list of context menu items, specific to whether
1183 ;; the symbol is a function, variable, or both. 1190 ;; the symbol is a function, variable, or both.
1184 ;; 4. activate-function will cause the function or variable to be described, 1191 ;; 5. activate-function will cause the function or variable to be described,
1185 ;; replacing the existing help contents. 1192 ;; replacing the existing help contents.
1186 (save-excursion 1193 (save-excursion
1187 (set-buffer buffer) 1194 (set-buffer buffer)
1188 (let (b e name) 1195 (let (b e name)
1189 (while (re-search-forward help-symbol-regexp nil t) 1196 (while (re-search-forward help-symbol-regexp nil t)
1198 (documentation sym t)))) 1205 (documentation sym t))))
1199 (when (or var fun) 1206 (when (or var fun)
1200 (let ((ex (make-extent b e))) 1207 (let ((ex (make-extent b e)))
1201 (set-extent-property ex 'mouse-face 'highlight) 1208 (set-extent-property ex 'mouse-face 'highlight)
1202 (set-extent-property ex 'help-symbol sym) 1209 (set-extent-property ex 'help-symbol sym)
1210 (set-extent-property ex 'face 'font-lock-reference-face)
1203 (set-extent-property 1211 (set-extent-property
1204 ex 'context-menu 1212 ex 'context-menu
1205 (cond ((and var fun) 1213 (cond ((and var fun)
1206 help-symbol-function-and-variable-context-menu) 1214 help-symbol-function-and-variable-context-menu)
1207 (var help-symbol-variable-context-menu) 1215 (var help-symbol-variable-context-menu)
1215 (help-symbol-run-function-1 ev ex 'describe-variable)))) 1223 (help-symbol-run-function-1 ev ex 'describe-variable))))
1216 ))))))) ;; 11 parentheses! 1224 ))))))) ;; 11 parentheses!
1217 1225
1218 (defun describe-function-1 (function &optional nodoc) 1226 (defun describe-function-1 (function &optional nodoc)
1219 "This function does the work for `describe-function'." 1227 "This function does the work for `describe-function'."
1220 (princ (format "`%s' is " function)) 1228 (princ "`")
1229 ;; (Help-princ-face function 'font-lock-function-name-face) overkill
1230 (princ function)
1231 (princ "' is ")
1221 (let* ((def function) 1232 (let* ((def function)
1222 aliases file-name autoload-file kbd-macro-p fndef macrop) 1233 aliases file-name autoload-file kbd-macro-p fndef macrop)
1223 (while (and (symbolp def) (fboundp def)) 1234 (while (and (symbolp def) (fboundp def))
1224 (when (not (eq def function)) 1235 (when (not (eq def function))
1225 (setq aliases 1236 (setq aliases
1279 (princ (format " -- loaded from \"%s\"\n" file-name))) 1290 (princ (format " -- loaded from \"%s\"\n" file-name)))
1280 ;; (terpri) 1291 ;; (terpri)
1281 (if describe-function-show-arglist 1292 (if describe-function-show-arglist
1282 (let ((arglist (function-arglist function))) 1293 (let ((arglist (function-arglist function)))
1283 (when arglist 1294 (when arglist
1284 (princ arglist) 1295 (Help-princ-face arglist 'font-lock-comment-face)
1285 (terpri)))) 1296 (terpri))))
1286 (terpri) 1297 (terpri)
1287 (cond (kbd-macro-p 1298 (cond (kbd-macro-p
1288 (princ "These characters are executed:\n\n\t") 1299 (princ "These characters are executed:\n\n\t")
1289 (princ (key-description def)) 1300 (princ (key-description def))
1419 (with-displaying-help-buffer 1430 (with-displaying-help-buffer
1420 (lambda () 1431 (lambda ()
1421 (let ((origvar variable) 1432 (let ((origvar variable)
1422 aliases) 1433 aliases)
1423 (let ((print-escape-newlines t)) 1434 (let ((print-escape-newlines t))
1424 (princ (format "`%s' is " (symbol-name variable))) 1435 (princ "`")
1436 ;; (Help-princ-face (symbol-name variable)
1437 ;; 'font-lock-variable-name-face) overkill
1438 (princ (symbol-name variable))
1439 (princ "' is ")
1425 (while (variable-alias variable) 1440 (while (variable-alias variable)
1426 (let ((newvar (variable-alias variable))) 1441 (let ((newvar (variable-alias variable)))
1427 (if aliases 1442 (if aliases
1428 ;; I18N3 Need gettext due to concat 1443 ;; I18N3 Need gettext due to concat
1429 (setq aliases 1444 (setq aliases
1441 (let ((file-name (describe-symbol-find-file variable))) 1456 (let ((file-name (describe-symbol-find-file variable)))
1442 (if file-name 1457 (if file-name
1443 (princ (format " -- loaded from \"%s\"\n" file-name)))) 1458 (princ (format " -- loaded from \"%s\"\n" file-name))))
1444 (princ "\nValue: ") 1459 (princ "\nValue: ")
1445 (if (not (boundp variable)) 1460 (if (not (boundp variable))
1446 (princ "void\n") 1461 (Help-princ-face "void\n" 'font-lock-comment-face)
1447 (prin1 (symbol-value variable)) 1462 (Help-prin1-face (symbol-value variable) 'font-lock-comment-face)
1448 (terpri)) 1463 (terpri))
1449 (terpri) 1464 (terpri)
1450 (cond ((local-variable-p variable (current-buffer)) 1465 (cond ((local-variable-p variable (current-buffer))
1451 (let* ((void (cons nil nil)) 1466 (let* ((void (cons nil nil))
1452 (def (condition-case nil 1467 (def (condition-case nil