comparison lisp/help.el @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents b9b8621c2439
children 79940b592197
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
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 ;; Copyright (C) 2001, 2002 Ben Wing.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: help, internal, dumped 7 ;; Keywords: help, internal, dumped
8 8
9 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
210 210
211 (defun help-quit () 211 (defun help-quit ()
212 (interactive) 212 (interactive)
213 nil) 213 nil)
214 214
215 ;; This is a grody hack of the same genotype as `advertised-undo'; if the 215 (define-obsolete-function-alias 'deprecated-help-command 'help-for-help)
216 ;; bindings of Backspace and C-h are the same, we want the menubar to claim
217 ;; that `info' is invoked with `C-h i', not `BS i'.
218
219 (defun deprecated-help-command ()
220 (interactive)
221 (if (eq 'help-command (key-binding "\C-h"))
222 (setq unread-command-event (character-to-event ?\C-h))
223 (help-for-help)))
224 216
225 ;;(define-key global-map 'backspace 'deprecated-help-command) 217 ;;(define-key global-map 'backspace 'deprecated-help-command)
226 218
227 ;; help-with-tutorial moved to help-nomule.el and mule-help.el. 219 (defconst tutorial-supported-languages
220 '(
221 ("Croatian" hr iso-8859-2)
222 ("Czech" cs iso-8859-2)
223 ("Dutch" nl iso-8859-1)
224 ("English" nil raw-text)
225 ("French" fr iso-8859-1)
226 ("German" de iso-8859-1)
227 ("Norwegian" no iso-8859-1)
228 ("Polish" pl iso-8859-2)
229 ("Romanian" ro iso-8859-2)
230 ("Slovak" sk iso-8859-2)
231 ("Slovenian" sl iso-8859-2)
232 ("Spanish" es iso-8859-1)
233 ("Swedish" se iso-8859-1)
234 )
235 "Alist of supported languages in TUTORIAL files.
236 Add languages here, as more are translated.")
237
238 ;; TUTORIAL arg is XEmacs addition
239 (defun help-with-tutorial (&optional tutorial language)
240 "Select the XEmacs learn-by-doing tutorial.
241 Optional arg TUTORIAL specifies the tutorial file; if not specified or
242 if this command is invoked interactively, the tutorial appropriate to
243 the current language environment is used. If there is no tutorial
244 written in that language, or if this version of XEmacs has no
245 international (Mule) support, the English-language tutorial is used.
246 With a prefix argument, you are asked to select which language."
247 (interactive "i\nP")
248 (when (and language (consp language))
249 (setq language
250 (if (featurep 'mule)
251 (or (declare-fboundp (read-language-name 'tutorial "Language: "))
252 (error "No tutorial file of the specified language"))
253 (let ((completion-ignore-case t))
254 (completing-read "Language: "
255 tutorial-supported-languages nil t)))))
256 (or language
257 (setq language
258 (if (featurep 'mule) (declare-boundp current-language-environment)
259 "English")))
260 (or tutorial
261 (setq tutorial
262 (cond ((featurep 'mule)
263 (or (declare-fboundp (get-language-info language 'tutorial))
264 "TUTORIAL"))
265 ((equal language "English") "TUTORIAL")
266 (t (format "TUTORIAL.%s"
267 (cadr (assoc language
268 tutorial-supported-languages)))))))
269 (let ((file (expand-file-name tutorial "~")))
270 (delete-other-windows)
271 (let ((buffer (or (get-file-buffer file)
272 (create-file-buffer file)))
273 (window-configuration (current-window-configuration)))
274 (condition-case error-data
275 (progn
276 (switch-to-buffer buffer)
277 (setq buffer-file-name file)
278 (setq default-directory (expand-file-name "~/"))
279 (setq buffer-auto-save-file-name nil)
280 ;; Because of non-Mule users, TUTORIALs are not coded
281 ;; independently, so we must guess the coding according to
282 ;; the language.
283 (let ((coding-system-for-read
284 (if (featurep 'mule)
285 (with-fboundp 'get-language-info
286 (or (get-language-info language
287 'tutorial-coding-system)
288 (car (get-language-info language
289 'coding-system))))
290 (nth 2 (assoc language tutorial-supported-languages)))))
291 (insert-file-contents (locate-data-file tutorial)))
292 (goto-char (point-min))
293 ;; [The 'didactic' blank lines: possibly insert blank lines
294 ;; around <<nya nya nya>> and replace << >> with [ ].] No more
295 ;; didactic blank lines. It was just a bad idea, anyway. I
296 ;; rewrote the TUTORIAL so it doesn't need them. However, some
297 ;; tutorials in other languages haven't yet been updated. ####
298 ;; Delete this code when they're all updated.
299 (if (re-search-forward "^<<.+>>" nil t)
300 (let ((n (- (window-height (selected-window))
301 (count-lines (point-min) (point-at-bol))
302 6)))
303 (if (< n 12)
304 (progn (beginning-of-line) (kill-line))
305 ;; Some people get confused by the large gap
306 (delete-backward-char 2)
307 (insert "]")
308 (beginning-of-line)
309 (save-excursion
310 (delete-char 2)
311 (insert "["))
312 (newline (/ n 2))
313 (next-line 1)
314 (newline (- n (/ n 2))))))
315 (goto-char (point-min))
316 (set-buffer-modified-p nil))
317 ;; TUTORIAL was not found: kill the buffer and restore the
318 ;; window configuration.
319 (file-error (kill-buffer buffer)
320 (set-window-configuration window-configuration)
321 ;; Now, signal the error
322 (signal (car error-data) (cdr error-data)))))))
228 323
229 ;; used by describe-key, describe-key-briefly, insert-key-binding, etc. 324 ;; used by describe-key, describe-key-briefly, insert-key-binding, etc.
230 (defun key-or-menu-binding (key &optional menu-flag) 325 (defun key-or-menu-binding (key &optional menu-flag)
231 "Return the command invoked by KEY. 326 "Return the command invoked by KEY.
232 Like `key-binding', but handles menu events and toolbar presses correctly. 327 Like `key-binding', but handles menu events and toolbar presses correctly.
640 (progn 735 (progn
641 (insert "Local Bindings:\n" heading) 736 (insert "Local Bindings:\n" heading)
642 (describe-bindings-internal local nil shadow prefix mouse-only-p) 737 (describe-bindings-internal local nil shadow prefix mouse-only-p)
643 (insert "\n") 738 (insert "\n")
644 (setq shadow (cons local shadow)))) 739 (setq shadow (cons local shadow))))
645 (insert "Global Bindings:\n" heading) 740 (if (console-on-window-system-p)
741 (progn
742 (insert "Global Window-System-Only Bindings:\n" heading)
743 (describe-bindings-internal global-window-system-map nil
744 shadow prefix mouse-only-p)
745 (push global-window-system-map shadow))
746 (insert "Global TTY-Only Bindings:\n" heading)
747 (describe-bindings-internal global-tty-map nil
748 shadow prefix mouse-only-p)
749 (push global-tty-map shadow))
750 (insert "\nGlobal Bindings:\n" heading)
646 (describe-bindings-internal (current-global-map) 751 (describe-bindings-internal (current-global-map)
647 nil shadow prefix mouse-only-p) 752 nil shadow prefix mouse-only-p)
648 (when (and prefix function-key-map (not mouse-only-p)) 753 (when (and prefix function-key-map (not mouse-only-p))
649 (insert "\nFunction key map translations:\n" heading) 754 (insert "\nFunction key map translations:\n" heading)
650 (describe-bindings-internal function-key-map nil nil 755 (describe-bindings-internal function-key-map nil nil