Function: tutorial--display-changes

tutorial--display-changes is a byte-compiled function defined in tutorial.el.gz.

Signature

(tutorial--display-changes)

Documentation

Display changes to some default key bindings.

If some of the default key bindings that the tutorial depends on have been changed then display the changes in the tutorial buffer with some explanatory links.

Source Code

;; Defined in /usr/src/emacs/lisp/tutorial.el.gz
(defun tutorial--display-changes ()
  "Display changes to some default key bindings.
If some of the default key bindings that the tutorial depends on
have been changed then display the changes in the tutorial buffer
with some explanatory links."
  (let* ((changed-keys (tutorial--find-changed-keys
			tutorial--default-keys))
	 ;; Alist of element (DESC . CK) where DESC is the
	 ;; key-description of a changed key and CK is the
	 ;; corresponding element in `changed-keys'.
	 (changed-keys-alist
	  (mapcar (lambda (ck) (cons (tutorial--key-description (car ck)) ck))
		  changed-keys))
	 changed-key
	 (start (point))
	 (case-fold-search nil)
	 (keybindings-regexp
	  ;; Accept either [:space:] or [:punct:] before the key
	  ;; binding because the Hebrew tutorial uses directional
	  ;; controls and Hebrew character maqaf, the Hebrew hyphen,
	  ;; immediately before the binding string.
	  (concat "\\(?:[[:space:]]\\|[[:punct:]]\\)\\("
		  (mapconcat (lambda (kdf) (regexp-quote
					    (tutorial--key-description
					     (nth 1 kdf))))
			     tutorial--default-keys
			     "\\|")
		  "\\)[[:punct:][:space:]]")))
    ;; Need the custom button face for viper buttons:
    (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)
				 '(tutorial-remark remark
				   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.
      (setq 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))
		  (def-fun (nth 1 ck))
		  (where   (nth 3 ck))
		  s1 s2 help-string)
	     (unless (string= where "Same key")
	       (when (string= where "")
		 (setq where (format "M-x %s" def-fun)))
	       (setq tutorial--point-after-chkeys (point-marker)
		     s1 (get-lang-string tutorial--lang 'tut-chgdkey)
		     s2 (get-lang-string tutorial--lang 'tut-chgdkey2)
		     help-string (and s1 s2 (format s1 desc where)))
	       (add-text-properties (match-beginning 1) (match-end 1)
				    '(face tutorial-warning-face
				      tutorial-remark key-sequence))
	       (if help-string
		   (if (nth 5 ck)
		       ;; Put help string in the tooltip.
		       (put-text-property (match-beginning 1) (match-end 1)
					  'help-echo help-string)
		     ;; Put help string in the buffer.
		     (save-excursion
		       (setcar (nthcdr 5 ck) t)
		       (forward-line)
		       ;; Two or more changed keys were on the same line.
		       (while (eq (get-text-property (point) 'tutorial-remark)
				  'remark)
			 (forward-line))
		       (setq start (point))
		       (insert "** " help-string " [")
		       (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)
					    '(tutorial-remark remark
					      rear-nonsticky t
					      face tutorial-warning-face
					      read-only t)))))))))))