comparison lisp/tutorial.el @ 74795:4404b91f3a72

(tutorial--detailed-help): Remove unnecessary link to the Emacs Lisp reference manual. (tutorial--tab-map): Remove. All callers changed. (tutorial--find-changed-keys): New elt QUIET, used to... (tutorial--display-changes): ...ensure that warning messages are only issued once per changed key. (tutorial--remove-remarks): Delete unused code-path. (lang-strings): Remove extraneous formatting.

74794:4a9998346e6e

                               (tutorial--find-changed-keys
				tutorial--default-keys)))))
        (when changed-keys
          (insert
           "The following key bindings used in the tutorial had been changed
from Emacs default in the " (buffer-name tutorial-buffer) " buffer:\n\n" )
          (let ((frm "   %-9s %-27s %-11s %s\n"))
            (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark")))
          (dolist (tk changed-keys)
            (let* ((def-fun     (nth 1 tk))
                   (key         (nth 0 tk))

                               'follow-link t)
                (insert "\n")))))

        (insert "
It is OK to change key bindings, but changed bindings do not
correspond to what the tutorial says.  (See also ")
        (insert-button "Key Binding Conventions"
                       'action
                       (lambda(button) (interactive)
                         (info
                          "(elisp) Key Binding Conventions")
                         (message "Type C-x 0 to close the new window"))
                       'follow-link t)
        (insert ".)\n\n")
        (print-help-return-message)))))

(defun tutorial--find-changed-keys (default-keys)
  "Find the key bindings that have changed.
Check if the default Emacs key bindings that the tutorial depends
on have been changed.

Return a list with the keys that have been changed.  The element
of this list have the following format:

  \(list KEY DEF-FUN DEF-FUN-TXT WHERE REMARK)

Where
  KEY         is a key sequence whose standard binding has been changed
  DEF-FUN     is the standard binding of KEY
  DEF-FUN-TXT is a short descriptive text for DEF-FUN
  WHERE       is a text describing the key sequences to which DEF-FUN is
              bound now (or, if it is remapped, a key sequence

              Here TEXT is a link text to show to the user.  The
              rest of the list is used to show information when
              the user clicks the link.

              KEY-FUN is the actual binding for KEY."
  (let (changed-keys remark)
    (dolist (kdf default-keys)
      ;; The variables below corresponds to those with the same names
      ;; described in the doc string.
      (let* ((key     (nth 1 kdf))

                             (equal key [?\C-z])
                             (eq key-fun 'undo))))
                   (setq remark (list "cua-mode, more info" 'cua-mode))
                   nil)
                  ((and cua-mode
                        (or
                         (and (eq def-fun 'ESC-prefix)
                              (equal key-fun
                                     `(keymap
                                       (118 . cua-repeat-replace-region))))
                         (and (eq def-fun 'mode-specific-command-prefix)
                              (equal key-fun
                                     '(keymap
                                       (timeout . copy-region-as-kill))))
                         (and (eq def-fun 'Control-X-prefix)
                              (equal key-fun
                                     '(keymap (timeout . kill-region))))))
                   (setq remark (list "cua-mode replacement" 'cua-mode))
                   (cond
                    ((eq def-fun 'mode-specific-command-prefix)
                     (setq def-fun-txt "\"C-c prefix\""))
                    ((eq def-fun 'Control-X-prefix)
                     (setq def-fun-txt "\"C-x prefix\""))
                    ((eq def-fun 'ESC-prefix)
                     (setq def-fun-txt "\"ESC prefix\"")))
                   (setq where "Same key")
                   nil)
                  ;; viper-mode specials:
                  ((and (boundp 'viper-mode-string)
			(boundp 'viper-current-state)

                   (setq remark
                         (list "more info" 'current-binding
                               key-fun def-fun key where))
                   nil))
          (add-to-list 'changed-keys
                       (list key def-fun def-fun-txt where remark)))))
    changed-keys))

(defvar tutorial--tab-map
  (let ((map (make-sparse-keymap)))
    (define-key map [tab] 'forward-button)
    (define-key map [(shift tab)] 'backward-button)
    (define-key map [(meta tab)] 'backward-button)
    map)
  "Keymap that allows tabbing between buttons.")

(defun tutorial--key-description (key)
  (let ((desc (key-description key)))
    (cond ((string= "ESC" desc) "<ESC>")
	  ((string= "RET" desc) "<Return>")

	 ;; 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))
	 (start (point))
	 (case-fold-search nil)
	 (keybindings-regexp
	  (concat "[[:space:]]\\("
		  (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)
				 '(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))))))))))))

(defun tutorial--saved-dir ()
  "Directory to which tutorials are saved."
  (expand-file-name "tutorial"
		    (if (eq system-type 'ms-dos) "~/_emacs.d/" "~/.emacs.d/")))

        (setq prop-end (next-single-property-change prop-start 'tutorial-remark))
        (setq prop-val (get-text-property prop-start 'tutorial-remark))
        (unless prop-end
          (setq prop-end (point-max)))
        (goto-char prop-end)
        (if (eq prop-val 'only-colored)
            (put-text-property prop-start prop-end 'face '(:background nil))
          (let ((orig-text (get-text-property prop-start 'tutorial-orig)))
            (delete-region prop-start prop-end)
            (when orig-text (insert orig-text))))))))

(defun tutorial--save-tutorial ()
  "Save the tutorial buffer.
This saves the part of the tutorial before and after the area
showing changed keys.  It also saves the point position and the

;; Below is some attempt to handle language specific strings. These
;; are currently only used in the tutorial.

(defconst lang-strings
  '(("English" .
     ((tut-chgdkey . "** %s has been rebound, but you can use %s instead [")
      (tut-chgdkey2 . "More")
      (tut-chgdhead . "
 NOTICE: The main purpose of the Emacs tutorial is to teach you
 the most important standard Emacs commands (key bindings).
 However, your Emacs has been customized by changing some of
 these basic editing commands, so it doesn't correspond to the
 tutorial.  We have inserted colored notices where the altered
 commands have been introduced. [")
      (tut-chgdhead2 . "More"))))
  "Language specific strings for Emacs.
This is an association list with the keys equal to the strings
that can be returned by `read-language-name'.  The elements in
the list are themselves association lists with keys that are

74795:4404b91f3a72

                               (tutorial--find-changed-keys
				tutorial--default-keys)))))
        (when changed-keys
          (insert
           "The following key bindings used in the tutorial had been changed
from the Emacs default in the " (buffer-name tutorial-buffer) " buffer:\n\n" )
          (let ((frm "   %-9s %-27s %-11s %s\n"))
            (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark")))
          (dolist (tk changed-keys)
            (let* ((def-fun     (nth 1 tk))
                   (key         (nth 0 tk))

                               'follow-link t)
                (insert "\n")))))

        (insert "
It is OK to change key bindings, but changed bindings do not
correspond to what the tutorial says.\n\n")
        (print-help-return-message)))))

(defun tutorial--find-changed-keys (default-keys)
  "Find the key bindings used in the tutorial that have changed.
Return a list with elements of the form

  '(KEY DEF-FUN DEF-FUN-TXT WHERE REMARK QUIET)

where

  KEY         is a key sequence whose standard binding has been changed
  DEF-FUN     is the standard binding of KEY
  DEF-FUN-TXT is a short descriptive text for DEF-FUN
  WHERE       is a text describing the key sequences to which DEF-FUN is
              bound now (or, if it is remapped, a key sequence

              Here TEXT is a link text to show to the user.  The
              rest of the list is used to show information when
              the user clicks the link.

              KEY-FUN is the actual binding for KEY.
  QUIET       is t if this changed keybinding should be handled quietly.
              This is used by `tutorial--display-changes'."
  (let (changed-keys remark)
    (dolist (kdf default-keys)
      ;; The variables below corresponds to those with the same names
      ;; described in the doc string.
      (let* ((key     (nth 1 kdf))

                             (equal key [?\C-z])
                             (eq key-fun 'undo))))
                   (setq remark (list "cua-mode, more info" 'cua-mode))
                   nil)
                  ((and cua-mode
                        (or (and (eq def-fun 'ESC-prefix)
				 (equal key-fun
                                     `(keymap
                                       (118 . cua-repeat-replace-region)))
				 (setq def-fun-txt "\"ESC prefix\""))
			    (and (eq def-fun 'mode-specific-command-prefix)
				 (equal key-fun
					'(keymap
					  (timeout . copy-region-as-kill)))
				 (setq def-fun-txt "\"C-c prefix\""))
			    (and (eq def-fun 'Control-X-prefix)
				 (equal key-fun
					'(keymap (timeout . kill-region)))
				 (setq def-fun-txt "\"C-x prefix\""))))
                   (setq remark (list "cua-mode replacement" 'cua-mode))
                   (setq where "Same key")
                   nil)
                  ;; viper-mode specials:
                  ((and (boundp 'viper-mode-string)
			(boundp 'viper-current-state)

                   (setq remark
                         (list "more info" 'current-binding
                               key-fun def-fun key where))
                   nil))
          (add-to-list 'changed-keys
                       (list key def-fun def-fun-txt where remark nil)))))
    changed-keys))

(defun tutorial--key-description (key)
  (let ((desc (key-description key)))
    (cond ((string= "ESC" desc) "<ESC>")
	  ((string= "RET" desc) "<Return>")

	 ;; 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
	  (concat "[[:space:]]\\("
		  (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))
		  (key     (nth 0 ck))
		  (def-fun (nth 1 ck))
		  (where   (nth 3 ck))
		  s1 s2 help-string)
	     (unless (string= where "Same key")
	       (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)))))))))))

(defun tutorial--saved-dir ()
  "Directory to which tutorials are saved."
  (expand-file-name "tutorial"
		    (if (eq system-type 'ms-dos) "~/_emacs.d/" "~/.emacs.d/")))

        (setq prop-end (next-single-property-change prop-start 'tutorial-remark))
        (setq prop-val (get-text-property prop-start 'tutorial-remark))
        (unless prop-end
          (setq prop-end (point-max)))
        (goto-char prop-end)
        (unless (eq prop-val 'key-sequence)
	  (delete-region prop-start prop-end))))))

(defun tutorial--save-tutorial ()
  "Save the tutorial buffer.
This saves the part of the tutorial before and after the area
showing changed keys.  It also saves the point position and the

;; Below is some attempt to handle language specific strings. These
;; are currently only used in the tutorial.

(defconst lang-strings
  '(("English" .
     ((tut-chgdkey . "%s has been rebound, but you can use %s instead")
      (tut-chgdkey2 . "More")
      (tut-chgdhead . "
 NOTICE: The main purpose of the Emacs tutorial is to teach you
 the most important standard Emacs commands (key bindings).
 However, your Emacs has been customized by changing some of
 these basic editing commands, so it doesn't correspond to the
 tutorial.  We have inserted colored notices where the altered
 commands have been introduced.")
      (tut-chgdhead2 . "More"))))
  "Language specific strings for Emacs.
This is an association list with the keys equal to the strings
that can be returned by `read-language-name'.  The elements in
the list are themselves association lists with keys that are