[RFC] Added an option to store content of the *scratch* buffer in a file.

[Michal Nazarewicz]

From: Michal Nazarewicz <address@hidden>

* lisp/startup.el (initial-scratch-message): Now accepts additional
'file value.
(scratch-recover-from-auto-save-file): New customize variable
describing behaviour of scratch auto-save file.
(scratch--custom-set): New helper function, used as a :set argument
for the above two variables.
(scratch--initialise, scratch--set-buffer-variables)
(scratch--insert-content, scratch--bury-on-kill-buffer): New functions
which initialise content of the *scratch* buffer.
(command-line-1): Use scratch--initialise function.
---
 Hi guys,

 I've been using this functionality for years now and, in my opinion,
 it's absolutely awesome.  It makes *scratch* to extremely useful
 buffer indeed!

 I haven't tested this patch extensively yet (since I've been using
 a simpler version of the code[1]), so at this point I'm just asking
 for feedback.  If you guys are interested in this, I'll test the code
 properly and send another version at later date.

 PS. I hope you don't mind I'm using git to send the patch.

 [1] https://github.com/mina86/dot-files/blob/master/dot-emacs#L1727

 etc/NEWS        |   4 ++
 lisp/ChangeLog  |  16 +++++++
 lisp/startup.el | 140 +++++++++++++++++++++++++++++++++++++++++++++++++-------
 3 files changed, 144 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c493e34..ac8ab80 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -87,6 +87,10 @@ simply disabling Transient Mark mode does the same thing.
 ** `initial-buffer-choice' can now specify a function to set up the
 initial buffer.
 
+** `initial-scratch-message' can now be 'file which makes content of
+the *scratch* buffer to be kept in a file.  This makes it possible to
+keep notes which will persist even when Emacs restarts in that buffer.
+
 ** `write-region-inhibit-fsync' now defaults to t in batch mode.
 
 ** ACL support has been added.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0d1e65c..949922b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+2013-06-05  Michal Nazarewicz  <address@hidden>
+
+       Added an option to store content of the *scratch* buffer in a file
+       in user-emacs-directory.  This makes it possible to keep notes
+       which will persist even when Emacs restarts in that buffer.
+       * startup.el (initial-scratch-message): Now accepts additional
+       'file value.
+       (scratch-recover-from-auto-save-file): New customize variable
+       describing behaviour of scratch auto-save file.
+       (scratch--custom-set): New helper function, used as a :set argument
+       for the above two variables.
+       (scratch--initialise, scratch--set-buffer-variables)
+       (scratch--insert-content, scratch--bury-on-kill-buffer): New functions
+       which initialise content of the *scratch* buffer.
+       (command-line-1): Use scratch--initialise function.
+
 2013-06-05  Teodor Zlatanov  <address@hidden>
 
        * net/tls.el (open-tls-stream): Remove unneeded buffer contents up
diff --git a/lisp/startup.el b/lisp/startup.el
index b7b4c15..7105a80 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1288,18 +1288,45 @@ settings will be marked as \"CHANGED outside of 
Customize\"."
           `((changed ((t :background ,color)))))
       (put 'cursor 'face-modified t))))
 
+(defun scratch--custom-set (symbol value)
+  (set-default symbol value)
+  ;; This function is called by defcustom so
+  ;; set-scratch-buffer-variables may be unbound yet.
+  (when (fboundp 'set-scratch-buffer-variables)
+    (set-scratch-buffer-variables)))
+
 (defcustom initial-scratch-message (purecopy "\
 ;; This buffer is for notes you don't want to save, and for Lisp evaluation.
 ;; If you want to create a file, visit that file with C-x C-f,
 ;; then enter the text in that file's own buffer.
 
 ")
-  "Initial message displayed in *scratch* buffer at startup.
-If this is nil, no message will be displayed."
+  "Initial message displayed in `*scratch*' buffer at startup.  If this is nil,
+no message will be displayed.  If this is symbol 'file content of the buffer
+will be read from a \"scratch\" file in `user-emacs-directory' and saved there
+when Emacs exists preserving it across restarts.
+
+As side effect of setting this to 'file, `*scratch*' buffer becomes immortal,
+ie. killing it will merely clear its content and bury it.
+
+When set via customize, various `*scratch*' buffer's local variables are
+modified by calling `set-scratch-buffer-variables' function."
   :type '(choice (text :tag "Message")
-                (const :tag "none" nil))
+                (const :tag "Read from scratch file" file)
+                (const :tag "None" nil))
+  :set 'scratch--custom-set
   :group 'initialization)
 
+(defcustom scratch-recover-from-auto-save-file 'ask
+  "What to do if scratch autosave file is newer than the scratch file.
+
+When set via customize, various `*scratch*' buffer's local variables are
+modified by calling `set-scratch-buffer-variables' function."
+  :type '(choice (const :tag "Always recover auto-save" t)
+                (const :tag "Never recover auto-save" nil)
+                (const :tag "Ask whether to recover auto-save" ask))
+  :set 'scratch--custom-set
+  :group 'initialization)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Fancy splash screen
@@ -2292,19 +2319,7 @@ A fancy display is used on graphic displays, normal 
otherwise."
            ;; abort later.
            (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
 
-    (when (eq initial-buffer-choice t)
-      ;; When initial-buffer-choice equals t make sure that *scratch*
-      ;; exists.
-      (get-buffer-create "*scratch*"))
-
-    ;; If *scratch* exists and is empty, insert initial-scratch-message.
-    ;; Do this before switching to *scratch* below to handle bug#9605.
-    (and initial-scratch-message
-        (get-buffer "*scratch*")
-        (with-current-buffer "*scratch*"
-          (when (zerop (buffer-size))
-            (insert initial-scratch-message)
-            (set-buffer-modified-p nil))))
+    (scratch--initialise)
 
     (when initial-buffer-choice
       (let ((buf
@@ -2383,4 +2398,97 @@ A fancy display is used on graphic displays, normal 
otherwise."
        (setq file (replace-match "/" t t file))))
     file))
 
+(defun scratch--initialise ()
+  "Initialises the *scratch* buffer.
+
+If `initial-buffer-choice' variable equals t *scratch* buffer will be created
+if it does not exist.  If it is empty its content will be populated depending
+on the `initial-scratch-message' variable.  (So if it's nil, the buffer will
+be left empty).
+
+Finally, hooks will be added which are affect the *scratch* buffer if
+`initial-scratch-message' variable equals 'file.  One will make the buffer
+immortal by burying it on kill, the other will save its content when Emacs
+exits."
+    (let ((buf (if (eq initial-buffer-choice t)
+                  (get-buffer-create "*scratch*")
+                (get-buffer "*scratch*"))))
+      (and buf
+          initial-scratch-message
+          (with-current-buffer buf
+            (when (zerop (buffer-size))
+              (scratch--insert-content)
+              (set-buffer-modified-p nil))))))
+
+(defconst scratch--initial-file-message (purecopy "\
+;; This buffer is for notes and for Lisp evaluation.
+;; If you want to create a file, visit that file with C-x C-f,
+;; then enter the text in that file's own buffer.
+;; Contents of this buffer will be saved across restarts.
+
+"))
+
+(defun scratch--set-buffer-variables ()
+  (if (eq initial-scratch-message 'file)
+      (progn
+       (setq buffer-file-name (concat user-emacs-directory "scratch")
+             buffer-save-without-query t)
+       (auto-save-mode (if scratch-recover-from-auto-save-file 1 -1))
+       (add-hook 'kill-buffer-query-functions 'scratch--bury-on-kill-buffer
+                 nil t))
+    (auto-save-mode -1)
+    (kill-local-variable 'buffer-file-name)
+    (kill-local-variable 'buffer-save-without-query)
+    (remove-hook 'kill-buffer-query-functions 'scratch--bury-on-kill-buffer)))
+
+(defun set-scratch-buffer-variables ()
+  "Sets `*sctrach*' local buffer variables based on customize options.
+
+If `*scratch*' buffer does not exist, this function does nothing.  Otherwise
+the following is affected:
+- `buffer-file-name' and `buffer-save-without-query' local variables,
+- `auto-save-mode', and
+- `kill-buffer-query-functions'."
+  (let ((buf (get-buffer "*scratch*")))
+    (when buf
+      (with-current-buffer buf
+       (stratch--set-buffer-variables)))))
+
+(defun scratch--insert-content ()
+  (if (not (eq initial-scratch-message 'file))
+      (insert initial-scratch-message)
+    (scratch--set-buffer-variables)
+    (let* ((have-file (file-readable-p buffer-file-name))
+          (have-auto-save (and buffer-auto-save-file-name
+                               (file-readable-p buffer-auto-save-file-name))))
+      ;; If autosave is older, pretend it does not exist.
+      (and have-file
+          have-auto-save
+          (not (file-newer-than-file-p buffer-auto-save-file-name
+                                       buffer-file-name))
+          (setq have-auto-save nil))
+      ;; If user wants us to always recover, pretend there's no base file.
+      (and have-auto-save
+          (eq t scratch-recover-from-auto-save-file)
+          (setq have-file nil))
+      ;; Ask user what to do.
+      (and have-file
+          have-auto-save
+          (if (y-or-n-p "Recover scratch file? ")
+              (setq have-file nil)
+            (setq have-auto-save nil)))
+      (let ((file (cond (have-file buffer-file-name)
+                       (have-auto-save buffer-auto-save-file-name))))
+       (if file
+           (insert-file-contents file nil nil nil t)
+         (insert scratch--initial-file-message))))))
+
+(defun scratch--bury-on-kill-buffer ()
+  (not (when (and (eq 'file initial-scratch-message)
+                 (string-equal (buffer-name (current-buffer)) "*scratch*"))
+        (erase-buffer)
+        (set-buffer-modified-p nil)
+        (bury-buffer)
+        t)))
+
 ;;; startup.el ends here
-- 
1.8.3