Advertisement
harlandski

(help-with-tutorial) modified to ask for save on to C-x-C-c

Jun 2nd, 2023
91
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.90 KB | None | 0 0
  1. (advice-add 'help-with-tutorial :override
  2. (defun help-with-tutorial-deals-with-c-x-c-c (&optional arg dont-ask-for-revert)
  3. "Select the Emacs learn-by-doing tutorial.
  4. If there is a tutorial version written in the language
  5. of the selected language environment, that version is used.
  6. If there's no tutorial in that language, `TUTORIAL' is selected.
  7. With ARG, you are asked to choose which language.
  8. If DONT-ASK-FOR-REVERT is non-nil the buffer is reverted without
  9. any question when restarting the tutorial.
  10.  
  11. If any of the standard Emacs key bindings that are used in the
  12. tutorial have been changed then an explanatory note about this is
  13. shown in the beginning of the tutorial buffer.
  14.  
  15. When the tutorial buffer is killed the content and the point
  16. position in the buffer is saved so that the tutorial may be
  17. resumed later."
  18. (interactive "P")
  19. (if (boundp 'viper-current-state)
  20. (let ((prompt1
  21. "You can not run the Emacs tutorial directly because you have \
  22. enabled Viper.")
  23. (prompt2 "\nThere is however a Viper tutorial you can run instead.
  24. Run the Viper tutorial? "))
  25. (if (fboundp 'viper-tutorial)
  26. (if (y-or-n-p (concat prompt1 prompt2))
  27. (progn (message "")
  28. (funcall 'viper-tutorial 0))
  29. (message "Tutorial aborted by user"))
  30. (message prompt1)))
  31. (let* ((lang (cond
  32. (arg
  33. (minibuffer-with-setup-hook #'minibuffer-completion-help
  34. (read-language-name 'tutorial "Language: " "English")))
  35. ((get-language-info current-language-environment 'tutorial)
  36. current-language-environment)
  37. (t "English")))
  38. (filename (get-language-info lang 'tutorial))
  39. (tut-buf-name filename)
  40. (old-tut-buf (get-buffer tut-buf-name))
  41. (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t)))
  42. (old-tut-is-ok (when old-tut-buf
  43. (not (buffer-modified-p old-tut-buf))))
  44. old-tut-file
  45. (old-tut-point 1))
  46. (setq tutorial--point-after-chkeys (point-min))
  47. ;; Try to display the tutorial buffer before asking to revert it.
  48. ;; If the tutorial buffer is shown in some window make sure it is
  49. ;; selected and displayed:
  50. (if old-tut-win
  51. (raise-frame
  52. (window-frame
  53. (select-window (get-buffer-window old-tut-buf t))))
  54. ;; Else, is there an old tutorial buffer? Then display it:
  55. (when old-tut-buf
  56. (switch-to-buffer old-tut-buf)))
  57. ;; Use whole frame for tutorial
  58. (delete-other-windows)
  59. ;; If the tutorial buffer has been changed then ask if it should
  60. ;; be reverted:
  61. (when (and old-tut-buf
  62. (not old-tut-is-ok))
  63. (setq old-tut-is-ok
  64. (if dont-ask-for-revert
  65. nil
  66. (not (y-or-n-p
  67. "You have changed the Tutorial buffer. Revert it? ")))))
  68. ;; (Re)build the tutorial buffer if it is not ok
  69. (unless old-tut-is-ok
  70. (switch-to-buffer (get-buffer-create tut-buf-name))
  71. ;; (unless old-tut-buf (text-mode))
  72. (unless lang (error "Variable lang is nil"))
  73. (setq tutorial--lang lang)
  74. (setq old-tut-file (file-exists-p (tutorial--saved-file)))
  75. (let ((inhibit-read-only t))
  76. (erase-buffer))
  77. (message "Preparing tutorial ...") (sit-for 0)
  78.  
  79. ;; Do not associate the tutorial buffer with a file. Instead use
  80. ;; a hook to save it when the buffer is killed.
  81. (setq buffer-auto-save-file-name nil)
  82. (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t)
  83. ;; Added by me
  84. (add-hook 'kill-emacs-query-functions 'tutorial--save-tutorial nil t)
  85.  
  86. ;; Insert the tutorial. First offer to resume last tutorial
  87. ;; editing session.
  88. (when dont-ask-for-revert
  89. (setq old-tut-file nil))
  90. (when old-tut-file
  91. (setq old-tut-file
  92. (y-or-n-p "Resume your last saved tutorial? ")))
  93. (if old-tut-file
  94. (progn
  95. (insert-file-contents (tutorial--saved-file))
  96. (let ((enable-local-variables :safe)
  97. (enable-local-eval nil)
  98. (enable-dir-local-variables nil)) ; bug#11127
  99. (hack-local-variables))
  100. (goto-char (point-min))
  101. (setq old-tut-point
  102. (string-to-number
  103. (buffer-substring-no-properties
  104. (line-beginning-position) (line-end-position))))
  105. (forward-line)
  106. (setq tutorial--point-before-chkeys
  107. (string-to-number
  108. (buffer-substring-no-properties
  109. (line-beginning-position) (line-end-position))))
  110. (forward-line)
  111. (delete-region (point-min) (point))
  112. (goto-char tutorial--point-before-chkeys)
  113. (setq tutorial--point-before-chkeys (point-marker)))
  114. (insert-file-contents (expand-file-name filename tutorial-directory))
  115. (let ((enable-local-variables :safe)
  116. (enable-local-eval nil)
  117. (enable-dir-local-variables nil)) ; bug#11127
  118. (hack-local-variables))
  119. (forward-line)
  120. (setq tutorial--point-before-chkeys (point-marker)))
  121.  
  122. (tutorial--display-changes)
  123.  
  124. ;; Clear message:
  125. (unless dont-ask-for-revert
  126. (message "") (sit-for 0))
  127.  
  128.  
  129. (if old-tut-file
  130. ;; Just move to old point in saved tutorial.
  131. (let ((old-point
  132. (if (> 0 old-tut-point)
  133. (- old-tut-point)
  134. (+ old-tut-point tutorial--point-after-chkeys))))
  135. (when (< old-point 1)
  136. (setq old-point 1))
  137. (goto-char old-point))
  138. ;; Delete the arch-tag line, so as not to confuse readers.
  139. (goto-char (point-max))
  140. (if (search-backward ";;; arch-tag: " nil t)
  141. (delete-region (point) (point-max)))
  142. (goto-char (point-min))
  143. (search-forward "\n<<")
  144. (beginning-of-line)
  145. ;; Convert the <<...>> line to the proper [...] line,
  146. ;; or just delete the <<...>> line if a [...] line follows.
  147. (cond ((save-excursion
  148. (forward-line 1)
  149. (looking-at-p "\\["))
  150. (delete-region (point) (progn (forward-line 1) (point))))
  151. ((looking-at "<<Blank lines inserted.*>>")
  152. (replace-match "[Middle of page left blank for didactic purposes. Text continues below]"))
  153. (t
  154. (looking-at "<<")
  155. (replace-match "[")
  156. (search-forward ">>")
  157. (replace-match "]")))
  158. (beginning-of-line)
  159. ;; FIXME: if the window is not tall, and especially if the
  160. ;; big red "NOTICE: The main purpose..." text has been
  161. ;; inserted at the start of the buffer, the "type C-v to
  162. ;; move to the next screen" might not be visible on the
  163. ;; first screen (n < 0). How will the novice know what to do?
  164. (let ((n (- (window-height)
  165. (count-lines (point-min) (point))
  166. 6)))
  167. (if (< n 8)
  168. (progn
  169. ;; For a short gap, we don't need the [...] line,
  170. ;; so delete it.
  171. (delete-region (point) (progn (end-of-line) (point)))
  172. (if (> n 0) (newline n)))
  173. ;; Some people get confused by the large gap.
  174. (newline (/ n 2))
  175.  
  176. ;; Skip the [...] line (don't delete it).
  177. (forward-line 1)
  178. (newline (- n (/ n 2)))))
  179. (goto-char (point-min)))
  180. (setq buffer-undo-list nil)
  181. (set-buffer-modified-p nil)))))
  182. )
  183.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement