- (when (boundp 'viper-mode-string)
- (require 'cus-edit))
- (let ((start (point))
- end
- (head (get-lang-string tutorial--lang 'tut-chgdhead))
- (head2 (get-lang-string tutorial--lang 'tut-chgdhead2)))
- (when (and head head2)
- (goto-char tutorial--point-before-chkeys)
- (insert head)
- (insert-button head2
- 'tutorial-buffer
- (current-buffer)
- ;;'tutorial-arg arg
- 'action
- 'tutorial--detailed-help
- 'follow-link t
- 'face 'link)
- (insert "]\n\n" )
- (when changed-keys
- (dolist (tk changed-keys)
- (let* ((def-fun (nth 1 tk))
- (key (nth 0 tk))
- (def-fun-txt (nth 2 tk))
- (where (nth 3 tk))
- (remark (nth 4 tk))
- (rem-fun (command-remapping def-fun))
- (key-txt (key-description key))
- (key-fun (key-binding key))
- tot-len)
- (unless (eq def-fun key-fun)
- ;; Mark the key in the tutorial text
- (unless (string= "Same key" where)
- (let ((here (point))
- (case-fold-search nil)
- (key-desc (key-description key)))
- (cond ((string= "ESC" key-desc)
- (setq key-desc "<ESC>"))
- ((string= "RET" key-desc)
- (setq key-desc "<Return>"))
- ((string= "DEL" key-desc)
- (setq key-desc "<Delback>")))
- (while (re-search-forward
- (concat "[[:space:]]\\("
- (regexp-quote key-desc)
- "\\)[[:space:]]") nil t)
- (put-text-property (match-beginning 1)
- (match-end 1)
- 'tutorial-remark 'only-colored)
- (put-text-property (match-beginning 1)
- (match-end 1)
- 'face 'tutorial-warning-face)
- (forward-line)
- (let ((s (get-lang-string tutorial--lang 'tut-chgdkey))
- (s2 (get-lang-string tutorial--lang 'tut-chgdkey2))
- (start (point))
- end)
- (when (and s s2)
- (setq s (format s key-desc where s2))
- (insert s)
- (insert-button s2
- 'tutorial-buffer
- (current-buffer)
- ;;'tutorial-arg arg
- 'action
- 'tutorial--detailed-help
- 'explain-key-desc key-desc
- 'follow-link t
- 'face 'link)
- (insert "] **")
- (insert "\n")
- (setq end (point))
- (put-text-property start end 'local-map tutorial--tab-map)
- ;; Add a property so we can remove the remark:
- (put-text-property start end 'tutorial-remark t)
- (put-text-property start end
- 'face 'tutorial-warning-face)
- (put-text-property start end 'read-only t))))
- (goto-char here)))))))
-
-
- (setq end (point))
- ;; Make the area with information about change key
- ;; bindings stand out:
- (put-text-property start end 'tutorial-remark t)
- (put-text-property start end
- 'face 'tutorial-warning-face)
- ;; Make it possible to use Tab/S-Tab between fields in
- ;; this area:
- (put-text-property start end 'local-map tutorial--tab-map)
- (setq tutorial--point-after-chkeys (point-marker))
- ;; Make this area read-only:
- (put-text-property start end 'read-only t)))))
+ (if (boundp 'viper-mode-string) (require 'cus-edit))
+
+ (if (or changed-keys (boundp 'viper-mode-string))
+ (let ((head (get-lang-string tutorial--lang 'tut-chgdhead))
+ (head2 (get-lang-string tutorial--lang 'tut-chgdhead2)))
+ (when (and head head2)
+ (goto-char tutorial--point-before-chkeys)
+ (insert head)
+ (insert-button head2 'tutorial-buffer (current-buffer)
+ 'action 'tutorial--detailed-help
+ 'follow-link t 'face 'link)
+ (insert "]\n\n")
+ (add-text-properties tutorial--point-before-chkeys (point)
+ '(local-map tutorial--tab-map
+ tutorial-remark t
+ face tutorial-warning-face
+ read-only t)))))
+
+ ;; Scan the tutorial for all key sequences.
+ (goto-char (point-min))
+ (while (re-search-forward keybindings-regexp (point-max) t)
+ ;; Then highlight each rebound key sequence.
+ ;; This avoids issuing a warning for, e.g., C-x C-b if C-b is rebound.
+ (let ((changed-key (assoc (match-string 1) changed-keys-alist)))
+ (and changed-key
+ (not (get-text-property (match-beginning 1) 'tutorial-remark))
+ (let* ((desc (car changed-key))
+ (ck (cdr changed-key))
+ (key (nth 0 ck))
+ (def-fun (nth 1 ck))
+ (where (nth 3 ck)))
+ (unless (string= where "Same key")
+ (setq tutorial--point-after-chkeys (point-marker))
+ (put-text-property (match-beginning 1)
+ (match-end 1)
+ 'face 'tutorial-warning-face)
+ (put-text-property (match-beginning 1)
+ (match-end 1)
+ 'tutorial-remark t)
+ (save-excursion
+ (forward-line)
+ (let ((s (get-lang-string tutorial--lang 'tut-chgdkey))
+ (s2 (get-lang-string tutorial--lang 'tut-chgdkey2))
+ (start (point)))
+ (when (and s s2)
+ (insert (format s desc where s2))
+ (insert-button s2 'tutorial-buffer (current-buffer)
+ 'action 'tutorial--detailed-help
+ 'explain-key-desc desc 'follow-link t
+ 'face 'link)
+ (insert "] **\n")
+ (add-text-properties start (point)
+ '(local-map tutorial--tab-map
+ tutorial-remark t
+ face tutorial-warning-face
+ read-only t))))))))))))