diff options
| -rw-r--r-- | lisp/tutorial.el | 48 |
1 files changed, 29 insertions, 19 deletions
diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 9cb890388f5..564797752fa 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el | |||
| @@ -35,6 +35,20 @@ | |||
| 35 | (require 'help-mode) ;; for function help-buffer | 35 | (require 'help-mode) ;; for function help-buffer |
| 36 | (eval-when-compile (require 'cl)) | 36 | (eval-when-compile (require 'cl)) |
| 37 | 37 | ||
| 38 | (defface tutorial-warning-face | ||
| 39 | '((((class color) (min-colors 88) (background light)) | ||
| 40 | (:foreground "Red1" :weight bold)) | ||
| 41 | (((class color) (min-colors 88) (background dark)) | ||
| 42 | (:foreground "Pink" :weight bold)) | ||
| 43 | (((class color) (min-colors 16) (background light)) | ||
| 44 | (:foreground "Red1" :weight bold)) | ||
| 45 | (((class color) (min-colors 16) (background dark)) | ||
| 46 | (:foreground "Pink" :weight bold)) | ||
| 47 | (((class color) (min-colors 8)) (:foreground "red")) | ||
| 48 | (t (:inverse-video t :weight bold))) | ||
| 49 | "Face used to highlight warnings in the tutorial." | ||
| 50 | :group 'font-lock-faces) | ||
| 51 | |||
| 38 | (defvar tutorial--point-before-chkeys 0 | 52 | (defvar tutorial--point-before-chkeys 0 |
| 39 | "Point before display of key changes.") | 53 | "Point before display of key changes.") |
| 40 | (make-variable-buffer-local 'tutorial--point-before-chkeys) | 54 | (make-variable-buffer-local 'tutorial--point-before-chkeys) |
| @@ -381,7 +395,8 @@ from Emacs default in the " (buffer-name tutorial-buffer) " buffer:\n\n" ) | |||
| 381 | (unless (eq def-fun key-fun) | 395 | (unless (eq def-fun key-fun) |
| 382 | ;; Insert key binding description: | 396 | ;; Insert key binding description: |
| 383 | (when (string= key-txt explain-key-desc) | 397 | (when (string= key-txt explain-key-desc) |
| 384 | (put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt)) | 398 | (put-text-property 0 (length key-txt) |
| 399 | 'face 'tutorial-warning-face key-txt)) | ||
| 385 | (insert " " key-txt " ") | 400 | (insert " " key-txt " ") |
| 386 | (setq tot-len (length key-txt)) | 401 | (setq tot-len (length key-txt)) |
| 387 | (when (> 9 tot-len) | 402 | (when (> 9 tot-len) |
| @@ -464,17 +479,17 @@ Where | |||
| 464 | (def-fun (nth 0 kdf)) | 479 | (def-fun (nth 0 kdf)) |
| 465 | (def-fun-txt (format "%s" def-fun)) | 480 | (def-fun-txt (format "%s" def-fun)) |
| 466 | (rem-fun (command-remapping def-fun)) | 481 | (rem-fun (command-remapping def-fun)) |
| 467 | (key-fun (key-binding key)) | 482 | (key-fun (if (eq def-fun 'ESC-prefix) |
| 483 | (lookup-key global-map [27]) | ||
| 484 | (key-binding key))) | ||
| 468 | (where (where-is-internal (if rem-fun rem-fun def-fun)))) | 485 | (where (where-is-internal (if rem-fun rem-fun def-fun)))) |
| 469 | (when (eq key-fun 'ESC-prefix) | ||
| 470 | (message "ESC-prefix!!!!")) | ||
| 471 | (if where | 486 | (if where |
| 472 | (progn | 487 | (progn |
| 473 | (setq where (key-description (car where))) | 488 | (setq where (key-description (car where))) |
| 474 | (when (and (< 10 (length where)) | 489 | (when (and (< 10 (length where)) |
| 475 | (string= (substring where 0 (length "<menu-bar>")) | 490 | (string= (substring where 0 (length "<menu-bar>")) |
| 476 | "<menu-bar>")) | 491 | "<menu-bar>")) |
| 477 | (setq where "The menus"))) | 492 | (setq where "the menus"))) |
| 478 | (setq where "")) | 493 | (setq where "")) |
| 479 | (setq remark nil) | 494 | (setq remark nil) |
| 480 | (unless | 495 | (unless |
| @@ -582,7 +597,7 @@ CHANGED-KEYS should be a list in the format returned by | |||
| 582 | 'action | 597 | 'action |
| 583 | 'tutorial--detailed-help | 598 | 'tutorial--detailed-help |
| 584 | 'follow-link t | 599 | 'follow-link t |
| 585 | 'face '(:inherit link :background "yellow")) | 600 | 'face 'link) |
| 586 | (insert "]\n\n" ) | 601 | (insert "]\n\n" ) |
| 587 | (when changed-keys | 602 | (when changed-keys |
| 588 | (dolist (tk changed-keys) | 603 | (dolist (tk changed-keys) |
| @@ -599,20 +614,22 @@ CHANGED-KEYS should be a list in the format returned by | |||
| 599 | ;; Mark the key in the tutorial text | 614 | ;; Mark the key in the tutorial text |
| 600 | (unless (string= "Same key" where) | 615 | (unless (string= "Same key" where) |
| 601 | (let ((here (point)) | 616 | (let ((here (point)) |
| 617 | (case-fold-search nil) | ||
| 602 | (key-desc (key-description key))) | 618 | (key-desc (key-description key))) |
| 603 | (while (search-forward key-desc nil t) | 619 | (while (re-search-forward |
| 620 | (concat (regexp-quote key-desc) | ||
| 621 | "[[:space:]]") nil t) | ||
| 604 | (put-text-property (match-beginning 0) | 622 | (put-text-property (match-beginning 0) |
| 605 | (match-end 0) | 623 | (match-end 0) |
| 606 | 'tutorial-remark 'only-colored) | 624 | 'tutorial-remark 'only-colored) |
| 607 | (put-text-property (match-beginning 0) | 625 | (put-text-property (match-beginning 0) |
| 608 | (match-end 0) | 626 | (match-end 0) |
| 609 | 'face '(:background "yellow")) | 627 | 'face 'tutorial-warning-face) |
| 610 | (forward-line) | 628 | (forward-line) |
| 611 | (let ((s (get-lang-string tutorial--lang 'tut-chgdkey)) | 629 | (let ((s (get-lang-string tutorial--lang 'tut-chgdkey)) |
| 612 | (s2 (get-lang-string tutorial--lang 'tut-chgdkey2)) | 630 | (s2 (get-lang-string tutorial--lang 'tut-chgdkey2)) |
| 613 | (start (point)) | 631 | (start (point)) |
| 614 | end) | 632 | end) |
| 615 | ;;(concat "** The key " key-desc " has been rebound, but you can use " where " instead [")) | ||
| 616 | (when (and s s2) | 633 | (when (and s s2) |
| 617 | (setq s (format s key-desc where s2)) | 634 | (setq s (format s key-desc where s2)) |
| 618 | (insert s) | 635 | (insert s) |
| @@ -624,7 +641,7 @@ CHANGED-KEYS should be a list in the format returned by | |||
| 624 | 'tutorial--detailed-help | 641 | 'tutorial--detailed-help |
| 625 | 'explain-key-desc key-desc | 642 | 'explain-key-desc key-desc |
| 626 | 'follow-link t | 643 | 'follow-link t |
| 627 | 'face '(:inherit link :background "yellow")) | 644 | 'face 'link) |
| 628 | (insert "] **") | 645 | (insert "] **") |
| 629 | (insert "\n") | 646 | (insert "\n") |
| 630 | (setq end (point)) | 647 | (setq end (point)) |
| @@ -632,7 +649,7 @@ CHANGED-KEYS should be a list in the format returned by | |||
| 632 | ;; Add a property so we can remove the remark: | 649 | ;; Add a property so we can remove the remark: |
| 633 | (put-text-property start end 'tutorial-remark t) | 650 | (put-text-property start end 'tutorial-remark t) |
| 634 | (put-text-property start end | 651 | (put-text-property start end |
| 635 | 'face '(:background "yellow" :foreground "#c00")) | 652 | 'face 'tutorial-warning-face) |
| 636 | (put-text-property start end 'read-only t)))) | 653 | (put-text-property start end 'read-only t)))) |
| 637 | (goto-char here))))))) | 654 | (goto-char here))))))) |
| 638 | 655 | ||
| @@ -642,14 +659,7 @@ CHANGED-KEYS should be a list in the format returned by | |||
| 642 | ;; bindings stand out: | 659 | ;; bindings stand out: |
| 643 | (put-text-property start end 'tutorial-remark t) | 660 | (put-text-property start end 'tutorial-remark t) |
| 644 | (put-text-property start end | 661 | (put-text-property start end |
| 645 | 'face | 662 | 'face 'tutorial-warning-face) |
| 646 | ;; The default warning face does not | ||
| 647 | ;;look good in this situation. Instead | ||
| 648 | ;;try something that could be | ||
| 649 | ;;recognized from warnings in normal | ||
| 650 | ;;life: | ||
| 651 | ;; 'font-lock-warning-face | ||
| 652 | (list :background "yellow" :foreground "#c00")) | ||
| 653 | ;; Make it possible to use Tab/S-Tab between fields in | 663 | ;; Make it possible to use Tab/S-Tab between fields in |
| 654 | ;; this area: | 664 | ;; this area: |
| 655 | (put-text-property start end 'local-map tutorial--tab-map) | 665 | (put-text-property start end 'local-map tutorial--tab-map) |