Mercurial > emacs
comparison lisp/tutorial.el @ 73550:6deaec97f21b
* help-fns.el (help-with-tutorial): Moved to tutorial.el.
* tutorial.el: New file.
(help-with-tutorial): Moved here from help-fns.el. Added help for
rebound keys. Fixed resume of tutorial.
(tutorial--describe-nonstandard-key, tutorial--sort-keys)
(tutorial--find-changed-keys, tutorial--display-changes)
(tutorial--saved-dir, tutorial--saved-file)
(tutorial--save-tutorial): New functions to support the changes in
help-with-tutorial.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 30 Oct 2006 14:30:59 +0000 |
parents | |
children | 8bd77d06776b |
comparison
equal
deleted
inserted
replaced
73549:e68d05a41cab | 73550:6deaec97f21b |
---|---|
1 ;;; tutorial.el --- tutorial for Emacs | |
2 | |
3 ;; Copyright (C) 2006 Free Software Foundation, Inc. | |
4 | |
5 ;; Maintainer: FSF | |
6 ;; Keywords: help, internal | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
23 ;; Boston, MA 02110-1301, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Code for running the Emacs tutorial. | |
28 | |
29 ;;; History: | |
30 | |
31 ;; File was created 2006-09. | |
32 | |
33 ;;; Code: | |
34 | |
35 (require 'help-mode) ;; for function help-buffer | |
36 (eval-when-compile (require 'cl)) | |
37 | |
38 | |
39 (defun tutorial--detailed-help (button) | |
40 "Give detailed help about changed keys." | |
41 (with-output-to-temp-buffer (help-buffer) | |
42 (help-setup-xref (list #'tutorial--detailed-help button) | |
43 (interactive-p)) | |
44 (with-current-buffer (help-buffer) | |
45 (let* ((tutorial-buffer (button-get button 'tutorial-buffer)) | |
46 ;;(tutorial-arg (button-get button 'tutorial-arg)) | |
47 (explain-key-desc (button-get button 'explain-key-desc)) | |
48 (changed-keys (with-current-buffer tutorial-buffer | |
49 (tutorial--find-changed-keys tutorial--default-keys)))) | |
50 (when changed-keys | |
51 (insert | |
52 "The following key bindings used in the tutorial had been changed | |
53 from Emacs default in the " (buffer-name tutorial-buffer) " buffer:\n\n" ) | |
54 (let ((frm " %-9s %-27s %-11s %s\n")) | |
55 (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark"))) | |
56 (dolist (tk changed-keys) | |
57 (let* ((def-fun (nth 1 tk)) | |
58 (key (nth 0 tk)) | |
59 (def-fun-txt (nth 2 tk)) | |
60 (where (nth 3 tk)) | |
61 (remark (nth 4 tk)) | |
62 (rem-fun (command-remapping def-fun)) | |
63 (key-txt (key-description key)) | |
64 (key-fun (with-current-buffer tutorial-buffer (key-binding key))) | |
65 tot-len) | |
66 (unless (eq def-fun key-fun) | |
67 ;; Insert key binding description: | |
68 (when (string= key-txt explain-key-desc) | |
69 (put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt)) | |
70 (insert " " key-txt " ") | |
71 (setq tot-len (length key-txt)) | |
72 (when (> 9 tot-len) | |
73 (insert (make-string (- 9 tot-len) ? )) | |
74 (setq tot-len 9)) | |
75 ;; Insert a link describing the old binding: | |
76 (insert-button def-fun-txt | |
77 'value def-fun | |
78 'action | |
79 (lambda(button) (interactive) | |
80 (describe-function | |
81 (button-get button 'value))) | |
82 'follow-link t) | |
83 (setq tot-len (+ tot-len (length def-fun-txt))) | |
84 (when (> 36 tot-len) | |
85 (insert (make-string (- 36 tot-len) ? ))) | |
86 (when (listp where) | |
87 (setq where "list")) | |
88 ;; Tell where the old binding is now: | |
89 (insert (format " %-11s " where)) | |
90 ;; Insert a link with more information, for example | |
91 ;; current binding and keymap or information about | |
92 ;; cua-mode replacements: | |
93 (insert-button (car remark) | |
94 'action | |
95 (lambda(b) (interactive) | |
96 (let ((value (button-get b 'value))) | |
97 (tutorial--describe-nonstandard-key value))) | |
98 'value (cdr remark) | |
99 'follow-link t) | |
100 (insert "\n"))))) | |
101 | |
102 (insert " | |
103 It is legitimate to change key bindings, but changed bindings do not | |
104 correspond to what the tutorial says. (See also " ) | |
105 (insert-button "Key Binding Conventions" | |
106 'action | |
107 (lambda(button) (interactive) | |
108 (info | |
109 "(elisp) Key Binding Conventions") | |
110 (message "Type C-x 0 to close the new window")) | |
111 'follow-link t) | |
112 (insert ".)\n\n") | |
113 (print-help-return-message))))) | |
114 | |
115 (defun tutorial--describe-nonstandard-key (value) | |
116 "Give more information about a changed key binding. | |
117 This is used in `help-with-tutorial'. The information includes | |
118 the key sequence that no longer has a default binding, the | |
119 default binding and the current binding. It also tells in what | |
120 keymap the new binding has been done and how to access the | |
121 function in the default binding from the keyboard. | |
122 | |
123 For `cua-mode' key bindings that try to combine CUA key bindings | |
124 with default Emacs bindings information about this is shown. | |
125 | |
126 VALUE should have either of these formats: | |
127 | |
128 \(cua-mode) | |
129 \(current-binding KEY-FUN DEF-FUN KEY WHERE) | |
130 | |
131 Where | |
132 KEY is a key sequence whose standard binding has been changed | |
133 KEY-FUN is the actual binding for KEY | |
134 DEF-FUN is the standard binding of KEY | |
135 WHERE is a text describing the key sequences to which DEF-FUN is | |
136 bound now (or, if it is remapped, a key sequence | |
137 for the function it is remapped to)" | |
138 (with-output-to-temp-buffer (help-buffer) | |
139 (help-setup-xref (list #'tutorial--describe-nonstandard-key value) | |
140 (interactive-p)) | |
141 (with-current-buffer (help-buffer) | |
142 (insert | |
143 "Your Emacs customizations override the default binding for this key:" | |
144 "\n\n") | |
145 (let ((inhibit-read-only t)) | |
146 (cond | |
147 ((eq (car value) 'cua-mode) | |
148 (insert | |
149 "CUA mode is enabled. | |
150 | |
151 When CUA mode is enabled, you can use C-z, C-x, C-c, and C-v to | |
152 undo, cut, copy, and paste in addition to the normal Emacs | |
153 bindings. The C-x and C-c keys only do cut and copy when the | |
154 region is active, so in most cases, they do not conflict with the | |
155 normal function of these prefix keys. | |
156 | |
157 If you really need to perform a command which starts with one of | |
158 the prefix keys even when the region is active, you have three | |
159 options: | |
160 - press the prefix key twice very quickly (within 0.2 seconds), | |
161 - press the prefix key and the following key within 0.2 seconds, or | |
162 - use the SHIFT key with the prefix key, i.e. C-S-x or C-S-c.")) | |
163 ((eq (car value) 'current-binding) | |
164 (let ((cb (nth 1 value)) | |
165 (db (nth 2 value)) | |
166 (key (nth 3 value)) | |
167 (where (nth 4 value)) | |
168 map | |
169 (maps (current-active-maps)) | |
170 mapsym) | |
171 ;; Look at the currently active keymaps and try to find | |
172 ;; first the keymap where the current binding occurs: | |
173 (while maps | |
174 (let* ((m (car maps)) | |
175 (mb (lookup-key m key t))) | |
176 (setq maps (cdr maps)) | |
177 (when (eq mb cb) | |
178 (setq map m) | |
179 (setq maps nil)))) | |
180 ;; Now, if a keymap was found we must found the symbol | |
181 ;; name for it to display to the user. This can not | |
182 ;; always be found since all keymaps does not have a | |
183 ;; symbol pointing to them, but here they should have | |
184 ;; that: | |
185 (when map | |
186 (mapatoms (lambda (s) | |
187 (and | |
188 ;; If not already found | |
189 (not mapsym) | |
190 ;; and if s is a keymap | |
191 (and (boundp s) | |
192 (keymapp (symbol-value s))) | |
193 ;; and not the local symbol map | |
194 (not (eq s 'map)) | |
195 ;; and the value of s is map | |
196 (eq map (symbol-value s)) | |
197 ;; then save this value in mapsym | |
198 (setq mapsym s))))) | |
199 (insert "The default Emacs binding for the key " | |
200 (key-description key) | |
201 " is the command `") | |
202 (insert (format "%s" db)) | |
203 (insert "'. " | |
204 "However, your customizations have rebound it to the command `") | |
205 (insert (format "%s" cb)) | |
206 (insert "'.") | |
207 (when mapsym | |
208 (insert " (For the more advanced user:" | |
209 " This binding is in the keymap `" | |
210 (format "%s" mapsym) | |
211 "'.)")) | |
212 (if (string= where "") | |
213 (unless (keymapp db) | |
214 (insert "\n\nYou can use M-x " | |
215 (format "%s" db) | |
216 " RET instead.")) | |
217 (insert "\n\nWith you current key bindings" | |
218 " you can use the key " | |
219 where | |
220 " to get the function `" | |
221 (format "%s" db) | |
222 "'.")) | |
223 ) | |
224 (fill-region (point-min) (point))))) | |
225 (print-help-return-message)))) | |
226 | |
227 (defun tutorial--sort-keys (left right) | |
228 "Sort predicate for use with `tutorial--default-keys'. | |
229 This is a predicate function to `sort'. | |
230 | |
231 The sorting is for presentation purpose only and is done on the | |
232 key sequence. | |
233 | |
234 LEFT and RIGHT are the elements to compare." | |
235 (let ((x (append (cadr left) nil)) | |
236 (y (append (cadr right) nil))) | |
237 ;; Skip the front part of the key sequences if they are equal: | |
238 (while (and x y | |
239 (listp x) (listp y) | |
240 (equal (car x) (car y))) | |
241 (setq x (cdr x)) | |
242 (setq y (cdr y))) | |
243 ;; Try to make a comparision that is useful for presentation (this | |
244 ;; could be made nicer perhaps): | |
245 (let ((cx (car x)) | |
246 (cy (car y))) | |
247 ;;(message "x=%s, y=%s;;;; cx=%s, cy=%s" x y cx cy) | |
248 (cond | |
249 ;; Lists? Then call this again | |
250 ((and cx cy | |
251 (listp cx) | |
252 (listp cy)) | |
253 (tutorial--sort-keys cx cy)) | |
254 ;; Are both numbers? Then just compare them | |
255 ((and (wholenump cx) | |
256 (wholenump cy)) | |
257 (> cx cy)) | |
258 ;; Is one of them a number? Let that be bigger then. | |
259 ((wholenump cx) | |
260 t) | |
261 ((wholenump cy) | |
262 nil) | |
263 ;; Are both symbols? Compare the names then. | |
264 ((and (symbolp cx) | |
265 (symbolp cy)) | |
266 (string< (symbol-name cy) | |
267 (symbol-name cx))) | |
268 )))) | |
269 | |
270 (defconst tutorial--default-keys | |
271 (let* ( | |
272 ;; On window system suspend Emacs is replaced in the | |
273 ;; default keymap so honor this here. | |
274 (suspend-emacs (if window-system | |
275 'iconify-or-deiconify-frame | |
276 'suspend-emacs)) | |
277 (default-keys | |
278 `( | |
279 ;; These are not mentioned but are basic: | |
280 (ESC-prefix [27]) | |
281 (Control-X-prefix [?\C-x]) | |
282 (mode-specific-command-prefix [?\C-c]) | |
283 | |
284 (save-buffers-kill-emacs [?\C-x ?\C-c]) | |
285 | |
286 | |
287 ;; * SUMMARY | |
288 (scroll-up [?\C-v]) | |
289 (scroll-down [?\M-v]) | |
290 (recenter [?\C-l]) | |
291 | |
292 | |
293 ;; * BASIC CURSOR CONTROL | |
294 (forward-char [?\C-f]) | |
295 (backward-char [?\C-b]) | |
296 | |
297 (forward-word [?\M-f]) | |
298 (backward-word [?\M-b]) | |
299 | |
300 (next-line [?\C-n]) | |
301 (previous-line [?\C-p]) | |
302 | |
303 (move-beginning-of-line [?\C-a]) | |
304 (move-end-of-line [?\C-e]) | |
305 | |
306 (backward-sentence [?\M-a]) | |
307 (forward-sentence [?\M-e]) | |
308 | |
309 | |
310 (beginning-of-buffer [?\M-<]) | |
311 (end-of-buffer [?\M->]) | |
312 | |
313 (universal-argument [?\C-u]) | |
314 | |
315 | |
316 ;; * WHEN EMACS IS HUNG | |
317 (keyboard-quit [?\C-g]) | |
318 | |
319 | |
320 ;; * DISABLED COMMANDS | |
321 (downcase-region [?\C-x ?\C-l]) | |
322 | |
323 | |
324 ;; * WINDOWS | |
325 (delete-other-windows [?\C-x ?1]) | |
326 ;; C-u 0 C-l | |
327 ;; Type CONTROL-h k CONTROL-f. | |
328 | |
329 | |
330 ;; * INSERTING AND DELETING | |
331 ;; C-u 8 * to insert ********. | |
332 | |
333 (delete-backward-char [backspace]) | |
334 (delete-char [?\C-d]) | |
335 | |
336 (backward-kill-word [(meta backspace)]) | |
337 (kill-word [?\M-d]) | |
338 | |
339 (kill-line [?\C-k]) | |
340 (kill-sentence [?\M-k]) | |
341 | |
342 (set-mark-command [?\C-@]) | |
343 (set-mark-command [?\C- ]) | |
344 (kill-region [?\C-w]) | |
345 (yank [?\C-y]) | |
346 (yank-pop [?\M-y]) | |
347 | |
348 | |
349 ;; * UNDO | |
350 (advertised-undo [?\C-x ?u]) | |
351 (advertised-undo [?\C-x ?u]) | |
352 | |
353 | |
354 ;; * FILES | |
355 (find-file [?\C-x ?\C-f]) | |
356 (save-buffer [?\C-x ?\C-s]) | |
357 | |
358 | |
359 ;; * BUFFERS | |
360 (list-buffers [?\C-x ?\C-b]) | |
361 (switch-to-buffer [?\C-x ?b]) | |
362 (save-some-buffers [?\C-x ?s]) | |
363 | |
364 | |
365 ;; * EXTENDING THE COMMAND SET | |
366 ;; C-x Character eXtend. Followed by one character. | |
367 (execute-extended-command [?\M-x]) | |
368 | |
369 ;; C-x C-f Find file | |
370 ;; C-x C-s Save file | |
371 ;; C-x s Save some buffers | |
372 ;; C-x C-b List buffers | |
373 ;; C-x b Switch buffer | |
374 ;; C-x C-c Quit Emacs | |
375 ;; C-x 1 Delete all but one window | |
376 ;; C-x u Undo | |
377 | |
378 | |
379 ;; * MODE LINE | |
380 (describe-mode [?\C-h ?m]) | |
381 | |
382 (set-fill-column [?\C-x ?f]) | |
383 (fill-paragraph [?\M-q]) | |
384 | |
385 | |
386 ;; * SEARCHING | |
387 (isearch-forward [?\C-s]) | |
388 (isearch-backward [?\C-r]) | |
389 | |
390 | |
391 ;; * MULTIPLE WINDOWS | |
392 (split-window-vertically [?\C-x ?2]) | |
393 (scroll-other-window [?\C-\M-v]) | |
394 (other-window [?\C-x ?o]) | |
395 (find-file-other-window [?\C-x ?4 ?\C-f]) | |
396 | |
397 | |
398 ;; * RECURSIVE EDITING LEVELS | |
399 (keyboard-escape-quit [27 27 27]) | |
400 | |
401 | |
402 ;; * GETTING MORE HELP | |
403 ;; The most basic HELP feature is C-h c | |
404 (describe-key-briefly [?\C-h ?c]) | |
405 (describe-key [?\C-h ?k]) | |
406 | |
407 | |
408 ;; * MORE FEATURES | |
409 ;; F10 | |
410 | |
411 | |
412 ;; * CONCLUSION | |
413 ;;(iconify-or-deiconify-frame [?\C-z]) | |
414 (,suspend-emacs [?\C-z]) | |
415 ))) | |
416 (sort default-keys 'tutorial--sort-keys)) | |
417 "Default Emacs key bindings that the tutorial depends on.") | |
418 | |
419 (defun tutorial--find-changed-keys (default-keys) | |
420 "Find the key bindings that have changed. | |
421 Check if the default Emacs key bindings that the tutorial depends | |
422 on have been changed. | |
423 | |
424 Return a list with the keys that have been changed. The element | |
425 of this list have the following format: | |
426 | |
427 \(list KEY DEF-FUN DEF-FUN-TXT WHERE REMARK) | |
428 | |
429 Where | |
430 KEY is a key sequence whose standard binding has been changed | |
431 DEF-FUN is the standard binding of KEY | |
432 DEF-FUN-TXT is a short descriptive text for DEF-FUN | |
433 WHERE is a text describing the key sequences to which DEF-FUN is | |
434 bound now (or, if it is remapped, a key sequence | |
435 for the function it is remapped to) | |
436 REMARK is a list with info about rebinding. It has either of these | |
437 formats: | |
438 | |
439 \(TEXT cua-mode) | |
440 \(TEXT current-binding KEY-FUN DEF-FUN KEY WHERE) | |
441 | |
442 Here TEXT is a link text to show to the user. The | |
443 rest of the list is used to show information when | |
444 the user clicks the link. | |
445 | |
446 KEY-FUN is the actual binding for KEY." | |
447 (let (changed-keys) | |
448 ;; (default-keys tutorial--default-keys)) | |
449 (dolist (kdf default-keys) | |
450 ;; The variables below corresponds to those with the same names | |
451 ;; described in the doc string. | |
452 (let* ((key (nth 1 kdf)) | |
453 (def-fun (nth 0 kdf)) | |
454 (def-fun-txt (format "%s" def-fun)) | |
455 (rem-fun (command-remapping def-fun)) | |
456 (key-fun (key-binding key)) | |
457 (where (where-is-internal (if rem-fun rem-fun def-fun)))) | |
458 (when (eq key-fun 'ESC-prefix) | |
459 (message "ESC-prefix!!!!")) | |
460 (if where | |
461 (progn | |
462 (setq where (key-description (car where))) | |
463 (when (and (< 10 (length where)) | |
464 (string= (substring where 0 (length "<menu-bar>")) | |
465 "<menu-bar>")) | |
466 (setq where "The menus"))) | |
467 (setq where "")) | |
468 (setq remark nil) | |
469 (unless | |
470 (cond ((eq key-fun def-fun) | |
471 ;; No rebinding, return t | |
472 t) | |
473 ((eq key-fun (command-remapping def-fun)) | |
474 ;; Just a remapping, return t | |
475 t) | |
476 ;; cua-mode specials: | |
477 ((and cua-mode | |
478 (or (and | |
479 (equal key [?\C-v]) | |
480 (eq key-fun 'cua-paste)) | |
481 (and | |
482 (equal key [?\C-z]) | |
483 (eq key-fun 'undo)))) | |
484 (setq remark (list "cua-mode, more info" 'cua-mode)) | |
485 nil) | |
486 ((and cua-mode | |
487 (or | |
488 (and (eq def-fun 'ESC-prefix) | |
489 (equal key-fun | |
490 `(keymap | |
491 (118 . cua-repeat-replace-region)))) | |
492 (and (eq def-fun 'mode-specific-command-prefix) | |
493 (equal key-fun | |
494 '(keymap | |
495 (timeout . copy-region-as-kill)))) | |
496 (and (eq def-fun 'Control-X-prefix) | |
497 (equal key-fun | |
498 '(keymap (timeout . kill-region)))))) | |
499 (setq remark (list "cua-mode replacement" 'cua-mode)) | |
500 (cond | |
501 ((eq def-fun 'mode-specific-command-prefix) | |
502 (setq def-fun-txt "\"C-c prefix\"")) | |
503 ((eq def-fun 'Control-X-prefix) | |
504 (setq def-fun-txt "\"C-x prefix\"")) | |
505 ((eq def-fun 'ESC-prefix) | |
506 (setq def-fun-txt "\"ESC prefix\""))) | |
507 (setq where "Same key") | |
508 nil) | |
509 ;; viper-mode specials: | |
510 ((and (boundp 'viper-mode-string) | |
511 (eq viper-current-state 'vi-state) | |
512 (or (and (eq def-fun 'isearch-forward) | |
513 (eq key-fun 'viper-isearch-forward)) | |
514 (and (eq def-fun 'isearch-backward) | |
515 (eq key-fun 'viper-isearch-backward)))) | |
516 ;; These bindings works as the default bindings, | |
517 ;; return t | |
518 t) | |
519 ((when normal-erase-is-backspace | |
520 (or (and (equal key [C-delete]) | |
521 (equal key-fun 'kill-word)) | |
522 (and (equal key [C-backspace]) | |
523 (equal key-fun 'backward-kill-word)))) | |
524 ;; This is the strange handling of C-delete and | |
525 ;; C-backspace, return t | |
526 t) | |
527 (t | |
528 ;; This key has indeed been rebound. Put information | |
529 ;; in `remark' and return nil | |
530 (setq remark | |
531 (list "more info" 'current-binding | |
532 key-fun def-fun key where)) | |
533 nil)) | |
534 (add-to-list 'changed-keys | |
535 (list key def-fun def-fun-txt where remark))))) | |
536 changed-keys)) | |
537 | |
538 (defvar tutorial--tab-map | |
539 (let ((map (make-sparse-keymap))) | |
540 (define-key map [tab] 'forward-button) | |
541 (define-key map [(shift tab)] 'backward-button) | |
542 (define-key map [(meta tab)] 'backward-button) | |
543 map) | |
544 "Keymap that allows tabbing between buttons.") | |
545 | |
546 (defun tutorial--display-changes (changed-keys) | |
547 "Display changes to some default key bindings. | |
548 If some of the default key bindings that the tutorial depends on | |
549 have been changed then display the changes in the tutorial buffer | |
550 with some explanatory links. | |
551 | |
552 CHANGED-KEYS should be a list in the format returned by | |
553 `tutorial--find-changed-keys'." | |
554 (when (or changed-keys | |
555 (boundp 'viper-mode-string)) | |
556 ;; Need the custom button face for viper buttons: | |
557 (when (boundp 'viper-mode-string) | |
558 (require 'cus-edit)) | |
559 (let ((start (point)) | |
560 end | |
561 (head (get-lang-string tutorial--lang 'tut-chgdhead)) | |
562 (head2 (get-lang-string tutorial--lang 'tut-chgdhead2))) | |
563 (when (and head head2) | |
564 (goto-char tutorial--point-before-chkeys) | |
565 (insert head) | |
566 (insert-button head2 | |
567 'tutorial-buffer | |
568 (current-buffer) | |
569 ;;'tutorial-arg arg | |
570 'action | |
571 'tutorial--detailed-help | |
572 'follow-link t | |
573 'face '(:inherit link :background "yellow")) | |
574 (insert "]\n\n" ) | |
575 (when changed-keys | |
576 (dolist (tk changed-keys) | |
577 (let* ((def-fun (nth 1 tk)) | |
578 (key (nth 0 tk)) | |
579 (def-fun-txt (nth 2 tk)) | |
580 (where (nth 3 tk)) | |
581 (remark (nth 4 tk)) | |
582 (rem-fun (command-remapping def-fun)) | |
583 (key-txt (key-description key)) | |
584 (key-fun (key-binding key)) | |
585 tot-len) | |
586 (unless (eq def-fun key-fun) | |
587 ;; Mark the key in the tutorial text | |
588 (unless (string= "Same key" where) | |
589 (let ((here (point)) | |
590 (key-desc (key-description key))) | |
591 (while (search-forward key-desc nil t) | |
592 (put-text-property (match-beginning 0) | |
593 (match-end 0) | |
594 'tutorial-remark 'only-colored) | |
595 (put-text-property (match-beginning 0) | |
596 (match-end 0) | |
597 'face '(:background "yellow")) | |
598 (forward-line) | |
599 (let ((s (get-lang-string tutorial--lang 'tut-chgdkey)) | |
600 (s2 (get-lang-string tutorial--lang 'tut-chgdkey2)) | |
601 (start (point)) | |
602 end) | |
603 ;;(concat "** The key " key-desc " has been rebound, but you can use " where " instead [")) | |
604 (when (and s s2) | |
605 (setq s (format s key-desc where s2)) | |
606 (insert s) | |
607 (insert-button s2 | |
608 'tutorial-buffer | |
609 (current-buffer) | |
610 ;;'tutorial-arg arg | |
611 'action | |
612 'tutorial--detailed-help | |
613 'explain-key-desc key-desc | |
614 'follow-link t | |
615 'face '(:inherit link :background "yellow")) | |
616 (insert "] **") | |
617 (insert "\n") | |
618 (setq end (point)) | |
619 (put-text-property start end 'local-map tutorial--tab-map) | |
620 ;; Add a property so we can remove the remark: | |
621 (put-text-property start end 'tutorial-remark t) | |
622 (put-text-property start end | |
623 'face '(:background "yellow" :foreground "#c00")) | |
624 (put-text-property start end 'read-only t)))) | |
625 (goto-char here))))))) | |
626 | |
627 | |
628 (setq end (point)) | |
629 ;; Make the area with information about change key | |
630 ;; bindings stand out: | |
631 (put-text-property start end 'tutorial-remark t) | |
632 (put-text-property start end | |
633 'face | |
634 ;; The default warning face does not | |
635 ;;look good in this situation. Instead | |
636 ;;try something that could be | |
637 ;;recognized from warnings in normal | |
638 ;;life: | |
639 ;; 'font-lock-warning-face | |
640 (list :background "yellow" :foreground "#c00")) | |
641 ;; Make it possible to use Tab/S-Tab between fields in | |
642 ;; this area: | |
643 (put-text-property start end 'local-map tutorial--tab-map) | |
644 (setq tutorial--point-after-chkeys (point-marker)) | |
645 ;; Make this area read-only: | |
646 (put-text-property start end 'read-only t))))) | |
647 | |
648 (defvar tutorial--point-before-chkeys 0 | |
649 "Point before display of key changes.") | |
650 (make-variable-buffer-local 'tutorial--point-before-chkeys) | |
651 (defvar tutorial--point-after-chkeys 0 | |
652 "Point after display of key changes.") | |
653 (make-variable-buffer-local 'tutorial--point-after-chkeys) | |
654 | |
655 (defvar tutorial--lang nil | |
656 "Tutorial language.") | |
657 (make-variable-buffer-local 'tutorial--lang) | |
658 | |
659 (defun tutorial--saved-dir () | |
660 "Directory where to save tutorials." | |
661 (expand-file-name ".emacstut" "~/")) | |
662 | |
663 (defun tutorial--saved-file () | |
664 "File name in which to save tutorials." | |
665 (let ((file-name tutorial--lang) | |
666 (ext (file-name-extension tutorial--lang))) | |
667 (when (or (not ext) | |
668 (string= ext "")) | |
669 (setq file-name (concat file-name ".tut"))) | |
670 (expand-file-name file-name (tutorial--saved-dir)))) | |
671 | |
672 (defun tutorial--remove-remarks() | |
673 "Remove the remark lines that was added to the tutorial buffer." | |
674 (save-excursion | |
675 (goto-char (point-min)) | |
676 (let (prop-start | |
677 prop-end | |
678 prop-val) | |
679 ;; Catch the case when we already are on a remark line | |
680 (while (if (get-text-property (point) 'tutorial-remark) | |
681 (setq prop-start (point)) | |
682 (setq prop-start (next-single-property-change (point) 'tutorial-remark))) | |
683 (setq prop-end (next-single-property-change prop-start 'tutorial-remark)) | |
684 (setq prop-val (get-text-property prop-start 'tutorial-remark)) | |
685 (unless prop-end | |
686 (setq prop-end (point-max))) | |
687 (goto-char prop-end) | |
688 (if (eq prop-val 'only-colored) | |
689 (put-text-property prop-start prop-end 'face '(:background nil)) | |
690 (let ((orig-text (get-text-property prop-start 'tutorial-orig))) | |
691 (delete-region prop-start prop-end) | |
692 (when orig-text (insert orig-text)))))))) | |
693 | |
694 (defun tutorial--save-tutorial () | |
695 "Save the tutorial buffer. | |
696 This saves the part of the tutorial before and after the area | |
697 showing changed keys. It also saves the point position and the | |
698 position where the display of changed bindings was inserted." | |
699 ;; This runs in a hook so protect it: | |
700 (condition-case err | |
701 (tutorial--save-tutorial-to (tutorial--saved-file)) | |
702 (error (message "Error saving tutorial state: %s" (error-message-string err)) | |
703 (sit-for 4)))) | |
704 | |
705 (defun tutorial--save-tutorial-to (saved-file) | |
706 "Save the tutorial buffer to SAVED-FILE. | |
707 See `tutorial--save-tutorial' for more information." | |
708 ;; Anything to save? | |
709 (when (or (buffer-modified-p) | |
710 (< 1 (point))) | |
711 (let ((tutorial-dir (tutorial--saved-dir)) | |
712 save-err) | |
713 ;; The tutorial is saved in a subdirectory in the user home | |
714 ;; directory. Create this subdirectory first. | |
715 (unless (file-directory-p tutorial-dir) | |
716 (condition-case err | |
717 (make-directory tutorial-dir nil) | |
718 (error (setq save-err t) | |
719 (warn "Could not create directory %s: %s" tutorial-dir | |
720 (error-message-string err))))) | |
721 ;; Make sure we have that directory. | |
722 (if (file-directory-p tutorial-dir) | |
723 (let ((tut-point (if (= 0 tutorial--point-after-chkeys) | |
724 ;; No info about changed keys is | |
725 ;; displayed. | |
726 (point) | |
727 (if (< (point) tutorial--point-after-chkeys) | |
728 (- (point)) | |
729 (- (point) tutorial--point-after-chkeys)))) | |
730 (old-point (point)) | |
731 ;; Use a special undo list so that we easily can undo | |
732 ;; the changes we make to the tutorial buffer. This is | |
733 ;; currently not needed since we now delete the buffer | |
734 ;; after saving, but kept for possible future use of | |
735 ;; this function. | |
736 buffer-undo-list | |
737 (inhibit-read-only t)) | |
738 ;; Delete the area displaying info about changed keys. | |
739 ;; (when (< 0 tutorial--point-after-chkeys) | |
740 ;; (delete-region tutorial--point-before-chkeys | |
741 ;; tutorial--point-after-chkeys)) | |
742 ;; Delete the remarks: | |
743 (tutorial--remove-remarks) | |
744 ;; Put the value of point first in the buffer so it will | |
745 ;; be saved with the tutorial. | |
746 (goto-char (point-min)) | |
747 (insert (number-to-string tut-point) | |
748 "\n" | |
749 (number-to-string (marker-position | |
750 tutorial--point-before-chkeys)) | |
751 "\n") | |
752 (condition-case err | |
753 (write-region nil nil saved-file) | |
754 (error (setq save-err t) | |
755 (warn "Could not save tutorial to %s: %s" | |
756 saved-file | |
757 (error-message-string err)))) | |
758 ;; An error is raised here?? Is this a bug? | |
759 (condition-case err | |
760 (undo-only) | |
761 (error nil)) | |
762 ;; Restore point | |
763 (goto-char old-point) | |
764 (if save-err | |
765 (message "Could not save tutorial state.") | |
766 (message "Saved tutorial state."))) | |
767 (message "Can't save tutorial: %s is not a directory" | |
768 tutorial-dir))))) | |
769 | |
770 | |
771 ;;;###autoload | |
772 (defun help-with-tutorial (&optional arg dont-ask-for-revert) | |
773 "Select the Emacs learn-by-doing tutorial. | |
774 If there is a tutorial version written in the language | |
775 of the selected language environment, that version is used. | |
776 If there's no tutorial in that language, `TUTORIAL' is selected. | |
777 With ARG, you are asked to choose which language. | |
778 If DONT-ASK-FOR-REVERT is non-nil the buffer is reverted without | |
779 any question when restarting the tutorial. | |
780 | |
781 If any of the standard Emacs key bindings that are used in the | |
782 tutorial have been changed then an explanatory note about this is | |
783 shown in the beginning of the tutorial buffer. | |
784 | |
785 When the tutorial buffer is killed the content and the point | |
786 position in the buffer is saved so that the tutorial may be | |
787 resumed later." | |
788 (interactive "P") | |
789 (if (boundp 'viper-current-state) | |
790 (let ((prompt | |
791 " | |
792 You can not run the Emacs tutorial directly because you have | |
793 enabled Viper. There is however a Viper tutorial you can run | |
794 instead. From this you can also run a slightly modified version | |
795 of the Emacs tutorial. | |
796 | |
797 Do you want to run the Viper tutorial instead? ")) | |
798 (if (y-or-n-p prompt) | |
799 (progn | |
800 (message "") | |
801 (viper-tutorial 0)) | |
802 (message "Tutorial aborted by user"))) | |
803 | |
804 (let* ((lang (if arg | |
805 (let ((minibuffer-setup-hook minibuffer-setup-hook)) | |
806 (add-hook 'minibuffer-setup-hook | |
807 'minibuffer-completion-help) | |
808 (read-language-name 'tutorial "Language: " "English")) | |
809 (if (get-language-info current-language-environment 'tutorial) | |
810 current-language-environment | |
811 "English"))) | |
812 (filename (get-language-info lang 'tutorial)) | |
813 ;; Choose a buffer name including the language so that | |
814 ;; several languages can be tested simultaneously: | |
815 (tut-buf-name (concat "TUTORIAL (" lang ")")) | |
816 (old-tut-buf (get-buffer tut-buf-name)) | |
817 (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t))) | |
818 (old-tut-is-ok (when old-tut-buf | |
819 (not (buffer-modified-p old-tut-buf)))) | |
820 old-tut-file | |
821 (old-tut-point 1)) | |
822 (setq tutorial--point-after-chkeys (point-min)) | |
823 ;; Try to display the tutorial buffer before asking to revert it. | |
824 ;; If the tutorial buffer is shown in some window make sure it is | |
825 ;; selected and displayed: | |
826 (if old-tut-win | |
827 (raise-frame | |
828 (window-frame | |
829 (select-window (get-buffer-window old-tut-buf t)))) | |
830 ;; Else, is there an old tutorial buffer? Then display it: | |
831 (when old-tut-buf | |
832 (switch-to-buffer old-tut-buf))) | |
833 ;; Use whole frame for tutorial | |
834 (delete-other-windows) | |
835 ;; If the tutorial buffer has been changed then ask if it should | |
836 ;; be reverted: | |
837 (when (and old-tut-buf | |
838 (not old-tut-is-ok)) | |
839 (setq old-tut-is-ok | |
840 (if dont-ask-for-revert | |
841 nil | |
842 (not (y-or-n-p | |
843 "You have changed the Tutorial buffer. Revert it? "))))) | |
844 ;; (Re)build the tutorial buffer if it is not ok | |
845 (unless old-tut-is-ok | |
846 (switch-to-buffer (get-buffer-create tut-buf-name)) | |
847 (unless old-tut-buf (text-mode)) | |
848 (unless lang (error "Variable lang is nil")) | |
849 (setq tutorial--lang lang) | |
850 (setq old-tut-file (file-exists-p (tutorial--saved-file))) | |
851 (let ((inhibit-read-only t)) | |
852 (erase-buffer)) | |
853 (message "Preparing tutorial ...") (sit-for 0) | |
854 | |
855 ;; Do not associate the tutorial buffer with a file. Instead use | |
856 ;; a hook to save it when the buffer is killed. | |
857 (setq buffer-auto-save-file-name nil) | |
858 (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t) | |
859 | |
860 ;; Insert the tutorial. First offer to resume last tutorial | |
861 ;; editing session. | |
862 (when dont-ask-for-revert | |
863 (setq old-tut-file nil)) | |
864 (when old-tut-file | |
865 (setq old-tut-file | |
866 (y-or-n-p "Resume your last saved tutorial? "))) | |
867 (if old-tut-file | |
868 (progn | |
869 (insert-file-contents (tutorial--saved-file)) | |
870 (goto-char (point-min)) | |
871 (setq old-tut-point | |
872 (string-to-number | |
873 (buffer-substring-no-properties | |
874 (line-beginning-position) (line-end-position)))) | |
875 (forward-line) | |
876 (setq tutorial--point-before-chkeys | |
877 (string-to-number | |
878 (buffer-substring-no-properties | |
879 (line-beginning-position) (line-end-position)))) | |
880 (forward-line) | |
881 (delete-region (point-min) (point)) | |
882 (goto-char tutorial--point-before-chkeys) | |
883 (setq tutorial--point-before-chkeys (point-marker))) | |
884 (insert-file-contents (expand-file-name filename data-directory)) | |
885 (forward-line) | |
886 (setq tutorial--point-before-chkeys (point-marker))) | |
887 | |
888 | |
889 ;; Check if there are key bindings that may disturb the | |
890 ;; tutorial. If so tell the user. | |
891 (let ((changed-keys (tutorial--find-changed-keys tutorial--default-keys))) | |
892 (when changed-keys | |
893 (tutorial--display-changes changed-keys))) | |
894 | |
895 | |
896 ;; Clear message: | |
897 (unless dont-ask-for-revert | |
898 (message "") (sit-for 0)) | |
899 | |
900 | |
901 (if old-tut-file | |
902 ;; Just move to old point in saved tutorial. | |
903 (let ((old-point | |
904 (if (> 0 old-tut-point) | |
905 (- old-tut-point) | |
906 (+ old-tut-point tutorial--point-after-chkeys)))) | |
907 (when (< old-point 1) | |
908 (setq old-point 1)) | |
909 (goto-char old-point)) | |
910 (goto-char (point-min)) | |
911 (search-forward "\n<<") | |
912 (beginning-of-line) | |
913 ;; Convert the <<...>> line to the proper [...] line, | |
914 ;; or just delete the <<...>> line if a [...] line follows. | |
915 (cond ((save-excursion | |
916 (forward-line 1) | |
917 (looking-at "\\[")) | |
918 (delete-region (point) (progn (forward-line 1) (point)))) | |
919 ((looking-at "<<Blank lines inserted.*>>") | |
920 (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) | |
921 (t | |
922 (looking-at "<<") | |
923 (replace-match "[") | |
924 (search-forward ">>") | |
925 (replace-match "]"))) | |
926 (beginning-of-line) | |
927 (let ((n (- (window-height (selected-window)) | |
928 (count-lines (point-min) (point)) | |
929 6))) | |
930 (if (< n 8) | |
931 (progn | |
932 ;; For a short gap, we don't need the [...] line, | |
933 ;; so delete it. | |
934 (delete-region (point) (progn (end-of-line) (point))) | |
935 (newline n)) | |
936 ;; Some people get confused by the large gap. | |
937 (newline (/ n 2)) | |
938 | |
939 ;; Skip the [...] line (don't delete it). | |
940 (forward-line 1) | |
941 (newline (- n (/ n 2))))) | |
942 (goto-char (point-min))) | |
943 (setq buffer-undo-list nil) | |
944 (set-buffer-modified-p nil))))) | |
945 | |
946 | |
947 ;; Below is some attempt to handle language specific strings. These | |
948 ;; are currently only used in the tutorial. | |
949 | |
950 (defconst lang-strings | |
951 '( | |
952 ("English" . | |
953 ( | |
954 (tut-chgdkey . "** The key %s has been rebound, but you can use %s instead [") | |
955 (tut-chgdkey2 . "More information") | |
956 (tut-chgdhead . " | |
957 NOTICE: The main purpose of the Emacs tutorial is to teach you | |
958 the most important standard Emacs commands (key bindings). | |
959 However, your Emacs has been customized by changing some of | |
960 these basic editing commands, so it doesn't correspond to the | |
961 tutorial. We have inserted colored notices where the altered | |
962 commands have been introduced. [") | |
963 (tut-chgdhead2 . "Details") | |
964 ) | |
965 ) | |
966 ) | |
967 "Language specific strings for Emacs. | |
968 This is an association list with the keys equal to the strings | |
969 that can be returned by `read-language-name'. The elements in | |
970 the list are themselves association lists with keys that are | |
971 string ids and values that are the language specific strings. | |
972 | |
973 See `get-lang-string' for more information.") | |
974 | |
975 (defun get-lang-string(lang stringid &optional no-eng-fallback) | |
976 "Get a language specific string for Emacs. | |
977 In certain places Emacs can replace a string showed to the user with a language specific string. | |
978 This function retrieves such strings. | |
979 | |
980 LANG is the language specification. It should be one of those | |
981 strings that can be returned by `read-language-name'. STRINGID | |
982 is a symbol that specifies the string to retrieve. | |
983 | |
984 If no string is found for STRINGID in the choosen language then | |
985 the English string is returned unless NO-ENG-FALLBACK is non-nil. | |
986 | |
987 See `lang-strings' for more information. | |
988 | |
989 Currently this feature is only used in `help-with-tutorial'." | |
990 (let ((my-lang-strings (assoc lang lang-strings)) | |
991 (found-string)) | |
992 (when my-lang-strings | |
993 (let ((entry (assoc stringid (cdr my-lang-strings)))) | |
994 (when entry | |
995 (setq found-string (cdr entry))))) | |
996 ;; Fallback to English strings | |
997 (unless (or found-string | |
998 no-eng-fallback) | |
999 (setq found-string (get-lang-string "English" stringid t))) | |
1000 found-string)) | |
1001 | |
1002 ;;(get-lang-string "English" 'tut-chgdkey) | |
1003 | |
1004 (provide 'tutorial) | |
1005 | |
1006 ;;; tutorial.el ends here |