Add tutorial-org, refactor tutorial, and lots of supporting changes.

6 files changed, 231 insertions, 176 deletions

diff --git a/etc/tutorials-org/tutorial.org b/etc/tutorials-org/tutorial.org
index b1cfb004f7e..72533738bba 100644
--- a/etc/tutorials-org/tutorial.org
+++ b/etc/tutorials-org/tutorial.org
@@ -177,6 +177,7 @@ persistently on a server, or even shared by several users at the same time for
 remote, collaborative working. It is also extremely useful for systems
 administration either when running over SSH or as a root user.
 
+
 * Text in Emacs
 
 In this section, we consider how Emacs allows you to view and to change text
@@ -188,7 +189,7 @@ extra options useful for changing text rapidly.
 If you wish to practice on this tutorial, do not worry, you can change it
 freely as it is just a copy.
 
-** TODO Editing Text
+** Editing Text
 
 Changing text happens in Emacs as with most other applications. A blinking
 cursor shows the current location in the file. Text can be selected with a
@@ -206,7 +207,6 @@ or "'" depending on your keyboard layout. What may surprise you is the extent
 to which Emacs expands on this idea of multiple keypresses, and it is this
 that we will consider in the next section.
 
-
 * Keyboard Control
 
 We said earlier, that as well as being modifiable, it is possible to disable
diff --git a/lisp/emacs-lisp/subdirs.el b/lisp/emacs-lisp/subdirs.el
new file mode 100644
index 00000000000..f99c9fba8ce
--- /dev/null
+++ b/lisp/emacs-lisp/subdirs.el
@@ -0,0 +1,8 @@
+;; In load-path, after this directory should come
+;; certain of its subdirectories.  Here we specify them.
+(normal-top-level-add-to-load-path '("m-buffer" "assess" ))
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
diff --git a/lisp/startup.el b/lisp/startup.el
index bc60bbd08b8..a6165ed750e 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -434,6 +434,13 @@ Warning Warning!!!  Pure space overflow    !!!Warning Warning
   :type 'directory
   :initialize #'custom-initialize-delay)
 
+(defcustom tutorial-org-directory
+  (file-name-as-directory (expand-file-name "tutorials-org" data-directory))
+  "Directory containing the Emacs TUTORIAL files."
+  :group 'installation
+  :type 'directory
+  :initialize #'custom-initialize-delay)
+
 (defun normal-top-level-add-subdirs-to-load-path ()
   "Recursively add all subdirectories of `default-directory' to `load-path'.
 More precisely, this uses only the subdirectories whose names
diff --git a/lisp/tutorial-org.el b/lisp/tutorial-org.el
new file mode 100644
index 00000000000..f71cd653880
--- /dev/null
+++ b/lisp/tutorial-org.el
@@ -0,0 +1,36 @@
+;;; tutorial.el --- tutorial for Emacs
+
+;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: help, internal
+;; Package: emacs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Code for running the Emacs Tutorials written in org-mode.
+
+;;; Code:
+
+
+(defun tutorial-org--help-with-tutorial-org (lang)
+  (error "not implemented yet"))
+
+(provide 'tutorial-org)
+
+;;; tutorial-org.el ends here
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index c1e8c3092e9..9a0c2468a8a 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (require 'help-mode) ;; for function help-buffer
+(require 'tutorial-org)
 
 (defface tutorial-warning-face
   '((t :inherit font-lock-warning-face))
@@ -753,178 +754,173 @@ position in the buffer is saved so that the tutorial may be
 resumed later."
   (interactive "P")
   (if (boundp 'viper-current-state)
-      (let ((prompt1
-             "You can not run the Emacs tutorial directly because you have \
+      (message "You can not run the Emacs tutorial directly because you have
 enabled Viper.")
-	    (prompt2 "\nThere is however a Viper tutorial you can run instead.
-Run the Viper tutorial? "))
-	(if (fboundp 'viper-tutorial)
-	    (if (y-or-n-p (concat prompt1 prompt2))
-		(progn (message "")
-		       (funcall 'viper-tutorial 0))
-	      (message "Tutorial aborted by user"))
-	  (message prompt1)))
-    (let* ((lang (cond
-                  (arg
-                   (minibuffer-with-setup-hook #'minibuffer-completion-help
-                     (read-language-name 'tutorial "Language: " "English")))
-                  ((get-language-info current-language-environment 'tutorial)
-                   current-language-environment)
-                  (t "English")))
+    (let* ((lang
+            (cond
+             (arg
+              (minibuffer-with-setup-hook #'minibuffer-completion-help
+                (read-language-name 'tutorial "Language: " "English")))
+             ((get-language-info current-language-environment 'tutorial)
+              current-language-environment)
+             (t "English")))
            (tutorial-type
             (if (get-language-info lang 'tutorial-org)
-                'org 'orig))
-           (filename
-            (or
-             (get-language-info lang 'tutorial-org)
-             (get-language-info lang 'tutorial)))
-           (tut-buf-name filename)
-           (old-tut-buf (get-buffer tut-buf-name))
-           (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t)))
-           (old-tut-is-ok (when old-tut-buf
-                            (not (buffer-modified-p old-tut-buf))))
-           old-tut-file
-           (old-tut-point 1))
-      (setq tutorial--point-after-chkeys (point-min))
-      ;; Try to display the tutorial buffer before asking to revert it.
-      ;; If the tutorial buffer is shown in some window make sure it is
-      ;; selected and displayed:
-      (if old-tut-win
-          (raise-frame
-           (window-frame
-            (select-window (get-buffer-window old-tut-buf t))))
-        ;; Else, is there an old tutorial buffer? Then display it:
-        (when old-tut-buf
-          (switch-to-buffer old-tut-buf)))
-      ;; Use whole frame for tutorial
-      (delete-other-windows)
-      ;; If the tutorial buffer has been changed then ask if it should
-      ;; be reverted:
-      (when (and old-tut-buf
-                 (not old-tut-is-ok))
-        (setq old-tut-is-ok
-              (if dont-ask-for-revert
-                  nil
-                (not (y-or-n-p
-                      "You have changed the Tutorial buffer.  Revert it? ")))))
-      ;; (Re)build the tutorial buffer if it is not ok
-      (unless old-tut-is-ok
-        (switch-to-buffer (get-buffer-create tut-buf-name))
-        ;; (unless old-tut-buf (text-mode))
-        (unless lang (error "Variable lang is nil"))
-        (setq tutorial--lang lang)
-        (setq old-tut-file (file-exists-p (tutorial--saved-file tutorial-type)))
-        (let ((inhibit-read-only t))
-          (erase-buffer))
-        (message "Preparing tutorial ...")
-        (sit-for 0)
-
-        ;; Do not associate the tutorial buffer with a file. Instead use
-        ;; a hook to save it when the buffer is killed.
-        (setq buffer-auto-save-file-name nil)
-        (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t)
-
-        ;; Insert the tutorial. First offer to resume last tutorial
-        ;; editing session.
-        (when dont-ask-for-revert
-          (setq old-tut-file nil))
-        (when old-tut-file
-          (setq old-tut-file
-                (y-or-n-p "Resume your last saved tutorial? ")))
-        (if old-tut-file
-            (progn
-              (insert-file-contents (tutorial--saved-file))
-	      (let ((enable-local-variables :safe)
-                    (enable-local-eval nil)
-                    (enable-dir-local-variables nil)) ; bug#11127
-		(hack-local-variables))
-              (goto-char (point-min))
-              (setq old-tut-point
-                    (string-to-number
-                     (buffer-substring-no-properties
-                      (line-beginning-position) (line-end-position))))
-              (forward-line)
-              (setq tutorial--point-before-chkeys
-                    (string-to-number
-                     (buffer-substring-no-properties
-                      (line-beginning-position) (line-end-position))))
-              (forward-line)
-              (delete-region (point-min) (point))
-              (goto-char tutorial--point-before-chkeys)
-              (setq tutorial--point-before-chkeys (point-marker)))
-          (insert-file-contents (expand-file-name filename tutorial-directory))
-	  (let ((enable-local-variables :safe)
-                (enable-local-eval nil)
-                (enable-dir-local-variables nil)) ; bug#11127
-	    (hack-local-variables))
-          (forward-line)
-          (setq tutorial--point-before-chkeys (point-marker)))
-
-	(tutorial--display-changes)
-
-        ;; Clear message:
-        (unless dont-ask-for-revert
-          (message "") (sit-for 0))
-
-
-        (if old-tut-file
-            ;; Just move to old point in saved tutorial.
-            (let ((old-point
-                   (if (> 0 old-tut-point)
-                       (- old-tut-point)
-                     (+ old-tut-point tutorial--point-after-chkeys))))
-              (when (< old-point 1)
-                (setq old-point 1))
-              (goto-char old-point))
-          ;; Delete the arch-tag line, so as not to confuse readers.
-          (goto-char (point-max))
-          (if (search-backward ";;; arch-tag: " nil t)
-              (delete-region (point) (point-max)))
-          (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-p "\\["))
-                 (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)
-          ;; FIXME: if the window is not tall, and especially if the
-          ;; big red "NOTICE: The main purpose..." text has been
-          ;; inserted at the start of the buffer, the "type C-v to
-          ;; move to the next screen" might not be visible on the
-          ;; first screen (n < 0).  How will the novice know what to do?
-          (let ((n (- (window-height)
-                      (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)))
-                  (if (> n 0) (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)))))
+                'org 'orig)))
+      (if (get-language-info lang 'tutorial-org)
+          (tutorial--help-with-tutorial-org lang)
+        (tutorial--help-with-tutorial-orig lang dont-ask-for-revert)))))
+
+(defun tutorial--help-with-tutorial-orig (lang dont-ask-for-revert)
+  (let* ((filename
+          (get-language-info lang 'tutorial))
+         (tut-buf-name filename)
+         (old-tut-buf (get-buffer tut-buf-name))
+         (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t)))
+         (old-tut-is-ok (when old-tut-buf
+                          (not (buffer-modified-p old-tut-buf))))
+         old-tut-file
+         (old-tut-point 1))
+    (setq tutorial--point-after-chkeys (point-min))
+    ;; Try to display the tutorial buffer before asking to revert it.
+    ;; If the tutorial buffer is shown in some window make sure it is
+    ;; selected and displayed:
+    (if old-tut-win
+        (raise-frame
+         (window-frame
+          (select-window (get-buffer-window old-tut-buf t))))
+      ;; Else, is there an old tutorial buffer? Then display it:
+      (when old-tut-buf
+        (switch-to-buffer old-tut-buf)))
+    ;; Use whole frame for tutorial
+    (delete-other-windows)
+    ;; If the tutorial buffer has been changed then ask if it should
+    ;; be reverted:
+    (when (and old-tut-buf
+               (not old-tut-is-ok))
+      (setq old-tut-is-ok
+            (if dont-ask-for-revert
+                nil
+              (not (y-or-n-p
+                    "You have changed the Tutorial buffer.  Revert it? ")))))
+    ;; (Re)build the tutorial buffer if it is not ok
+    (unless old-tut-is-ok
+      (switch-to-buffer (get-buffer-create tut-buf-name))
+      ;; (unless old-tut-buf (text-mode))
+      (unless lang (error "Variable lang is nil"))
+      (setq tutorial--lang lang)
+      (setq old-tut-file (file-exists-p (tutorial--saved-file tutorial-type)))
+      (let ((inhibit-read-only t))
+        (erase-buffer))
+      (message "Preparing tutorial ...")
+      (sit-for 0)
+
+      ;; Do not associate the tutorial buffer with a file. Instead use
+      ;; a hook to save it when the buffer is killed.
+      (setq buffer-auto-save-file-name nil)
+      (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t)
+
+      ;; Insert the tutorial. First offer to resume last tutorial
+      ;; editing session.
+      (when dont-ask-for-revert
+        (setq old-tut-file nil))
+      (when old-tut-file
+        (setq old-tut-file
+              (y-or-n-p "Resume your last saved tutorial? ")))
+      (if old-tut-file
+          (progn
+            (insert-file-contents (tutorial--saved-file))
+            (let ((enable-local-variables :safe)
+                  (enable-local-eval nil)
+                  (enable-dir-local-variables nil)) ; bug#11127
+              (hack-local-variables))
+            (goto-char (point-min))
+            (setq old-tut-point
+                  (string-to-number
+                   (buffer-substring-no-properties
+                    (line-beginning-position) (line-end-position))))
+            (forward-line)
+            (setq tutorial--point-before-chkeys
+                  (string-to-number
+                   (buffer-substring-no-properties
+                    (line-beginning-position) (line-end-position))))
+            (forward-line)
+            (delete-region (point-min) (point))
+            (goto-char tutorial--point-before-chkeys)
+            (setq tutorial--point-before-chkeys (point-marker)))
+        (insert-file-contents
+         (expand-file-name filename tutorial-directory))
+        (let ((enable-local-variables :safe)
+              (enable-local-eval nil)
+              (enable-dir-local-variables nil)) ; bug#11127
+          (hack-local-variables))
+        (forward-line)
+        (setq tutorial--point-before-chkeys (point-marker)))
+
+      (tutorial--display-changes)
+
+      ;; Clear message:
+      (unless dont-ask-for-revert
+        (message "") (sit-for 0))
+
+
+      (if old-tut-file
+          ;; Just move to old point in saved tutorial.
+          (let ((old-point
+                 (if (> 0 old-tut-point)
+                     (- old-tut-point)
+                   (+ old-tut-point tutorial--point-after-chkeys))))
+            (when (< old-point 1)
+              (setq old-point 1))
+            (goto-char old-point))
+        ;; Delete the arch-tag line, so as not to confuse readers.
+        (goto-char (point-max))
+        (if (search-backward ";;; arch-tag: " nil t)
+            (delete-region (point) (point-max)))
+        (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-p "\\["))
+               (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)
+        ;; FIXME: if the window is not tall, and especially if the
+        ;; big red "NOTICE: The main purpose..." text has been
+        ;; inserted at the start of the buffer, the "type C-v to
+        ;; move to the next screen" might not be visible on the
+        ;; first screen (n < 0).  How will the novice know what to do?
+        (let ((n (- (window-height)
+                    (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)))
+                (if (> n 0) (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))))
 
 
 ;; 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")
diff --git a/test/lisp/tutorial-tests.el b/test/lisp/tutorial-tests.el
index 26cdb469247..b244d59a667 100644
--- a/test/lisp/tutorial-tests.el
+++ b/test/lisp/tutorial-tests.el
@@ -24,19 +24,27 @@
 
 (require 'ert)
 (require 'tutorial)
+(require 'assess)
 
 (ert-deftest tutorial--open-tutorial ()
   ;; We do not care about the return value (which happens to be nil),
   ;; but it should not error.
-  (should-not
-   (let ((current-language-environment "English"))
-     (help-with-tutorial)))
-  (should-not
-   (let ((current-language-environment "Russian"))
-     (help-with-tutorial)))
-  (should-error
-   (let ((current-language-environment "Elvish"))
-     (help-with-tutorial))))
+  (should
+   (assess-with-preserved-buffer-list
+    (let ((current-language-environment "Russian"))
+      (help-with-tutorial)
+      (remove-hook 'kill-buffer-hook 'tutorial--save-tutorial t)
+      t))))
+
+(ert-deftest tutorial--open-org-tutorial ()
+  :expected-result :failed
+  (should
+   (assess-with-preserved-buffer-list
+    (let ((current-language-environment "English"))
+      (help-with-tutorial)
+      (remove-hook 'kill-buffer-hook 'tutorial--save-tutorial t)
+      t))))
+
 
 
 (provide 'tutorial-tests)