Re: Patch to remove minor modes in tutorial

[Lennart Borgman <lennart.borgman.073@student.lu.se>]

Richard Stallman wrote:
> Please delete the ask-user code, and also the remove-minor code.  I am
> convinced that we don't want to do either of those things.
>   
Here is a new version of help-with-tutorial then. I have added some 
information instead that could be useful:

(defun help-describe-nonstandard-key(value)
  (let ((maps (current-active-maps t)))
    (with-output-to-temp-buffer (help-buffer)
      (help-setup-xref (list #'help-describe-nonstandard-key value)
                       (interactive-p))
      (with-current-buffer (help-buffer)
        (insert "Default key binding has been changed:\n\n")
        (let ((inhibit-read-only t))
          (cond
           ((eq (car value) 'cua-mode)
            (insert "You are using `cua-mode'."
                    "  In this mode the C-c prefix is rebound so"
                    " that it copies the region if it is active."
                    "  If the region is not active then C-c will"
                    " work as it normally does in Emacs."))
           ((eq (car value) 'current-binding)
            (let ((cb    (nth 1 value))
                  (db    (nth 2 value))
                  (key   (nth 3 value))
                  (where (nth 4 value))
                  map
                  mapsym)
              (while maps
                (let* ((m (car maps))
                       (mb (lookup-key m key t)))
                  (setq maps (cdr maps))
                  (when (eq mb cb)
                    (setq map m)
                    (setq maps nil))))
              (when map
                (if (eq map global-map)
                    (setq mapsym 'global-map)
                  (mapatoms (lambda (s)
                              (when (and (boundp s)
                                         (keymapp (symbol-value s)))
                                (unless (eq s 'map)
                                  (when (equal map (symbol-value s))
                                    (when (member map (current-active-maps))
                                      (setq mapsym s)))))))))
              (insert "Emacs default binding for the key "
                      (key-description key)
                      " is the function `")
              (insert (format "%s" db))
              (insert "'.  This key has however been rebound to the 
function `")
              (insert (format "%s" cb))
              (insert "'.")
              (when mapsym
                (insert "  This binding is in the keymap variable `")
                (insert (format "%s" mapsym))
                (insert "'."))
              (when where
                (insert "\n\nYou can use the key "
                        where
                        " to get the function `"
                        (format "%s" db)
                        "'."))
              ))))
        (fill-region (point-min)(point))
        (print-help-return-message)))))

(defun help-with-tutorial (&optional arg)
  "Select the Emacs learn-by-doing tutorial.
If there is a tutorial version written in the language
of the selected language environment, that version is used.
If there's no tutorial in that language, `TUTORIAL' is selected.
With ARG, you are asked to choose which language."
  (interactive "P")
  (let ((lang (if arg
                  (let ((minibuffer-setup-hook minibuffer-setup-hook))
                    (add-hook 'minibuffer-setup-hook
                              'minibuffer-completion-help)
                    (read-language-name 'tutorial "Language: " "English"))
        (if (get-language-info current-language-environment 'tutorial)
            current-language-environment
          "English")))
    file filename
        (point-after-message 1))
    (setq filename (get-language-info lang 'tutorial))
    (setq file (expand-file-name (concat "~/" filename)))
    (delete-other-windows)
    (if (get-file-buffer file)
    (switch-to-buffer (get-file-buffer file))
      (switch-to-buffer (create-file-buffer file))
      (setq buffer-file-name file)
      (setq default-directory (expand-file-name "~/"))
      (setq buffer-auto-save-file-name nil)
      (insert-file-contents (expand-file-name filename data-directory))
      (setq buffer-file-name nil)
      (hack-local-variables)


      ;; Check if there are key bindings that may disturb the
      ;; tutorial. If so tell the user.
      (let (initial-bad-keys)
        (with-temp-buffer
          (insert-file (locate-library "bindings.el"))
          (let (expr
                key
                def-fun
                def-fun-txt
                rem-fun
                key-fun
                where
                remark
                )
            (while (condition-case err
                       (setq expr (read (current-buffer)))
                     (error nil))
              (cond ((and (eq (nth 0 expr) 'define-key)
                          (eq (nth 1 expr) 'global-map))
                     (setq key (nth 2 expr))
                     (setq def-fun (nth 3 expr)))
                    ((eq (nth 0 expr) 'global-set-key)
                     (setq key (nth 1 expr))
                     (setq def-fun (nth 2 expr)))
                    (t
                     (setq key nil)))
              (when key
                (assert (eq (nth 0 def-fun) 'quote))
                (setq def-fun (nth 1 def-fun))
                (setq def-fun-txt (format "%s" def-fun))
                (setq rem-fun (command-remapping def-fun))
                (setq key-fun (key-binding key))
                (setq where (where-is-internal (if rem-fun rem-fun 
def-fun)))
                (if where
                    (setq where (key-description (car where)))
                  (setq where ""))
                (setq remark nil)
                (unless
                    (cond ( (eq key-fun def-fun)
                            t)
                          ( (eq key-fun (command-remapping def-fun))
                            (setq remark (list "Remapped" nil))
                            t)
                          ;; cua-mode special:
                          ( (and cua-mode
                                 (eq def-fun 'mode-specific-command-prefix)
                                 (equal key-fun
                                        '(keymap (timeout . 
copy-region-as-kill))))
                            (setq remark (list "cua-mode replacement" 
'cua-mode))
                            (setq def-fun-txt "\"C-c prefix\"")
                            (setq where "Same key")
                            nil)
                          ;; The strange handling of C-delete and
                          ;; C-backspace:
                          ( (when normal-erase-is-backspace
                              (or (and (equal key [C-delete])
                                       (equal key-fun 'kill-word))
                                  (and (equal key [C-backspace])
                                       (equal key-fun 
'backward-kill-word))))
                            t)
                          ( t
                            (setq remark
                                  (list "More info" 'current-binding
                                        key-fun def-fun key where))
                            nil))
                  (add-to-list 'initial-bad-keys
                               (list def-fun key def-fun-txt where 
remark)))))))

        (when initial-bad-keys
          (forward-line)
          (let ((start (point))
                fun-buttons
                remark-buttons)
            (insert "
 NOTICE: One of the main purposes of the tutorial is that You
 should be able to learn some important Emacs default key
 bindings.  However when you started the tutorial the following
 key bindings had been changed from Emacs default:\n\n"
                    )
            (let ((frm "   %-9s %-25s %-11s %s\n")
                  (keys initial-bad-keys))
              (insert (format frm "KEY" "DEFAULT BINDING" "IS NOW ON" 
"REMARK"))
              (dolist (tk keys)
                (let* ((def-fun     (nth 0 tk))
                       (key         (nth 1 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)))
                  (unless (eq def-fun key-fun)
                    (insert (format "   %-9s " key-txt))
                    (let ((beg (point))
                          end
                          len)
                      (insert def-fun-txt)
                      (setq end (point))
                      (setq len (- 25 (length def-fun-txt)))
                      (when (>= 0 len) (setq len 1))
                      (insert (make-string len ? ))
                      (add-to-list 'fun-buttons (list beg end def-fun))
                      (insert (format " %-11s " where))
                      (setq beg (point))
                      (insert (format "%s" (car remark)))
                      (setq end (point))
                      (add-to-list 'remark-buttons (list beg end (cdr 
remark)))
                      (insert "\n")
                      )))))

            (insert "
 Please understand that it is ok to change key bindings, but the
 tutorial may not work correctly. (See also "  )
            (setq link-beg (point))
            (insert "Key Binding Conventions")
            (setq link-end (point))
            (insert ".)\n\n")
            (put-text-property start (point)
                               'face
                               ;;'font-lock-warning-face
                               (list :background "yellow"
                                     :foreground "#c00")
                               )
            (dolist (b remark-buttons)
              (let ((beg (nth 0 b))
                     (end (nth 1 b))
                     (remark (nth 2 b)))
                (make-text-button beg end
                                  'action
                                  (lambda(b) (interactive)
                                    (let ((value (button-get b 'value)))
                                      (help-describe-nonstandard-key 
value)))
                                  'value remark
                                  'follow-link t
                                  'face '(:inherit link
                                                   :background "yellow"))))
            (dolist (b fun-buttons)
              (let ((beg (nth 0 b))
                    (end (nth 1 b))
                    (fun (nth 2 b)))
                (make-text-button beg end
                                  'value fun
                                  'action
                                  (lambda(button) (interactive)
                                    (describe-function
                                     (button-get button 'value)))
                                  'follow-link t
                                  'face '(:inherit link
                                                   :background "yellow"))))
            (make-text-button link-beg link-end
                              'action
                              (lambda(button) (interactive)
                                (info "(elisp) Key Binding Conventions"))
                              'follow-link t
                              'face '(:inherit link
                                               :background "yellow")))))

      (setq point-after-message (point))

      (goto-char (point-min))
      (set-buffer-modified-p nil))

    (goto-char (point-min))
    (search-forward "\n<<")
    (beginning-of-line)
    ;; Convert the <<...>> line to the proper [...] line,
    ;; or just delete the <<...>> line if a [...] line follows.
    (cond ((save-excursion
             (forward-line 1)
             (looking-at "\\["))
           (delete-region (point) (progn (forward-line 1) (point))))
          ((looking-at "<<Blank lines inserted.*>>")
           (replace-match "[Middle of page left blank for didactic 
purposes.   Text continues below]"))
          (t
           (looking-at "<<")
           (replace-match "[")
           (search-forward ">>")
           (replace-match "]")))
    (beginning-of-line)
    (let ((n (- (window-height (selected-window))
                (count-lines (point-min) (point))
                6)))
      (if (< n 8)
          (progn
            ;; For a short gap, we don't need the [...] line,
            ;; so delete it.
            (delete-region (point) (progn (end-of-line) (point)))
            (newline n))
        ;; Some people get confused by the large gap.
        (newline (/ n 2))

        ;; Skip the [...] line (don't delete it).
        (forward-line 1)
        (newline (- n (/ n 2)))))
    (goto-char (point-min))
    (setq buffer-undo-list nil)
    (set-buffer-modified-p nil)))