[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Patch to remove minor modes in tutorial

From: Lennart Borgman
Subject: Re: Patch to remove minor modes in tutorial
Date: Fri, 07 Jul 2006 02:01:33 +0200
User-agent: Thunderbird (Windows/20060516)

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)
     (with-current-buffer (help-buffer)
       (insert "Default key binding has been changed:\n\n")
       (let ((inhibit-read-only t))
          ((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))
             (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 "
                       " to get the function `"
                       (format "%s" db)
       (fill-region (point-min)(point))

(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
                   (read-language-name 'tutorial "Language: " "English"))
       (if (get-language-info current-language-environment 'tutorial)
   file filename
       (point-after-message 1))
   (setq filename (get-language-info lang 'tutorial))
   (setq file (expand-file-name (concat "~/" filename)))
   (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)

     ;; Check if there are key bindings that may disturb the
     ;; tutorial. If so tell the user.
     (let (initial-bad-keys)
         (insert-file (locate-library "bindings.el"))
         (let (expr
           (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)))
                    (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)
                   (cond ( (eq key-fun def-fun)
                         ( (eq key-fun (command-remapping def-fun))
                           (setq remark (list "Remapped" nil))
                         ;; 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")
                         ;; 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
                           (setq remark
                                 (list "More info" 'current-binding
                                       key-fun def-fun key where))
                 (add-to-list 'initial-bad-keys
(list def-fun key def-fun-txt where remark)))))))

       (when initial-bad-keys
         (let ((start (point))
           (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))
                     (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)
                              (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
                                 (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
                                 (lambda(button) (interactive)
                                    (button-get button 'value)))
                                 'follow-link t
                                 'face '(:inherit link
                                                  :background "yellow"))))
           (make-text-button link-beg link-end
                             (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<<")
   ;; 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]"))
          (looking-at "<<")
          (replace-match "[")
          (search-forward ">>")
          (replace-match "]")))
   (let ((n (- (window-height (selected-window))
               (count-lines (point-min) (point))
     (if (< n 8)
           ;; 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)))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]