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