aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/tutorial.el48
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)