unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Juri Linkov <juri@jurta.org>
To: Reuben Thomas <rrt@sc3d.org>
Cc: tomas@tuxteam.de, emacs-devel@gnu.org
Subject: Re: desktop.el: autosave?
Date: Thu, 11 Apr 2013 11:29:08 +0300	[thread overview]
Message-ID: <87k3o9v5bf.fsf@mail.jurta.org> (raw)
In-Reply-To: <CAOnWdogROqbatpc7v-1dr2so4mtz6dUwDmD+wcSvNWFN-Nfizg@mail.gmail.com> (Reuben Thomas's message of "Wed, 10 Apr 2013 11:57:27 +0100")

> I don't think anyone had a problem with run-with-timer (I just skimmed back
> through the thread to check), so go ahead and change my patch to use it.

In the patch below a new option is `desktop-auto-save-timeout' instead
of `desktop-auto-save-interval' because it should be more like
`auto-save-timeout' instead of `auto-save-interval'.

`auto-save-timeout' is the number of seconds between auto-saves, but
`auto-save-interval' is the number of characters typed between auto-saves.
In terms of the desktop, an interval would rather mean a number of changes
in the buffer list or something like that.  I'm not sure whether this is
useful, so the following patch implements only timer-based auto-saving:

=== modified file 'lisp/desktop.el'
--- lisp/desktop.el	2013-01-02 16:13:04 +0000
+++ lisp/desktop.el	2013-04-11 08:28:14 +0000
@@ -189,6 +189,17 @@ (defcustom desktop-save 'ask-if-new
   :group 'desktop
   :version "22.1")
 
+(defcustom desktop-auto-save-timeout nil
+  "Number of seconds between auto-saves of the desktop.
+Zero or nil means disable timer-based auto-saving."
+  :type '(choice (const :tag "Off" nil)
+                 (integer :tag "Seconds"))
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (desktop-auto-save-update))
+  :group 'desktop
+  :version "24.4")
+
 (defcustom desktop-load-locked-desktop 'ask
   "Specifies whether the desktop should be loaded if locked.
 Possible values are:
@@ -539,6 +550,10 @@ (defconst desktop-header
 (defvar desktop-delay-hook nil
   "Hooks run after all buffers are loaded; intended for internal use.")
 
+(defvar desktop-file-checksum nil
+  "Checksum of the last auto-saved contents of the desktop file.
+Used to avoid writing contents unchanged between auto-saves.")
+
 ;; ----------------------------------------------------------------------------
 ;; Desktop file conflict detection
 (defvar desktop-file-modtime nil
@@ -854,11 +869,12 @@ (defun desktop-file-name (filename dirna
 
 ;; ----------------------------------------------------------------------------
 ;;;###autoload
-(defun desktop-save (dirname &optional release)
+(defun desktop-save (dirname &optional release auto-save)
   "Save the desktop in a desktop file.
 Parameter DIRNAME specifies where to save the desktop file.
 Optional parameter RELEASE says whether we're done with this desktop.
-See also `desktop-base-file-name'."
+If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
+and don't save the buffer if they are the same."
   (interactive "DDirectory to save desktop file in: ")
   (setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
   (save-excursion
@@ -918,10 +934,17 @@ (defun desktop-save (dirname &optional r
 		(insert ")\n\n"))))
 
 	  (setq default-directory desktop-dirname)
-	  (let ((coding-system-for-write 'emacs-mule))
-	    (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
-	  ;; We remember when it was modified (which is presumably just now).
-	  (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))
+	  ;; If auto-saving, avoid writing if nothing has changed since the last write.
+	  ;; Don't check 300 characters of the header that contains the timestamp.
+	  (let ((checksum (and auto-save (md5 (current-buffer)
+					      (+ 300 (point-min)) (point-max)
+					      'emacs-mule))))
+	    (unless (and auto-save (equal checksum desktop-file-checksum))
+	      (let ((coding-system-for-write 'emacs-mule))
+		(write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
+	      (setq desktop-file-checksum checksum)
+	      ;; We remember when it was modified (which is presumably just now).
+	      (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))))
 
 ;; ----------------------------------------------------------------------------
 ;;;###autoload
@@ -1075,6 +1098,37 @@ (defun desktop-save-in-desktop-dir ()
   (message "Desktop saved in %s" (abbreviate-file-name desktop-dirname)))
 
 ;; ----------------------------------------------------------------------------
+;; Auto-Saving.
+(defvar desktop-auto-save-timer nil)
+
+(defun desktop-auto-save ()
+  "Save the desktop periodically.
+Called by the timer created in `desktop-auto-save-update'."
+  (when (and desktop-save-mode
+	     (integerp desktop-auto-save-timeout)
+	     (> desktop-auto-save-timeout 0)
+	     ;; Avoid desktop saving during lazy loading.
+	     (not desktop-lazy-timer)
+	     ;; Save only to own desktop file.
+	     (eq (emacs-pid) (desktop-owner))
+	     desktop-dirname)
+    (desktop-save desktop-dirname nil t))
+  (desktop-auto-save-update))
+
+(defun desktop-auto-save-update ()
+  "Update the timer for next auto-saving.
+Cancel the previous timer and run a new timer when the number
+of seconds between auto-saves is a positive integer."
+  (when desktop-auto-save-timer
+    (cancel-timer desktop-auto-save-timer)
+    (setq desktop-auto-save-timer nil))
+  (when (and (integerp desktop-auto-save-timeout)
+	     (> desktop-auto-save-timeout 0))
+    (setq desktop-auto-save-timer
+	  (run-with-timer desktop-auto-save-timeout nil
+			  'desktop-auto-save))))
+
+;; ----------------------------------------------------------------------------
 ;;;###autoload
 (defun desktop-revert ()
   "Revert to the last loaded desktop."
@@ -1327,6 +1381,7 @@ (add-hook 'after-init-hook
         (setq desktop-save-mode nil)))
     (when desktop-save-mode
       (desktop-read)
+      (desktop-auto-save-update)
       (setq inhibit-startup-screen t))))
 
 (provide 'desktop)




  reply	other threads:[~2013-04-11  8:29 UTC|newest]

Thread overview: 56+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <alpine.DEB.0.99999.0711301407250.4037@localhost.localdomain>
2007-11-30 23:35 ` desktop.el: autosave? Richard Stallman
2007-12-01  0:35   ` Juri Linkov
2007-12-01 23:41     ` Richard Stallman
2007-12-03 22:57       ` Juri Linkov
2007-12-04  7:39         ` martin rudalics
2007-12-05  2:57           ` Richard Stallman
2007-12-05  9:02             ` martin rudalics
2007-12-05 22:28               ` Juri Linkov
2007-12-05 23:09                 ` martin rudalics
2007-12-05 23:41                   ` Juri Linkov
2007-12-06 15:12                     ` Richard Stallman
2007-12-06  2:11               ` Richard Stallman
2007-12-06 23:29                 ` Juri Linkov
2007-12-04 16:55         ` Richard Stallman
2007-12-06 14:58         ` Reuben Thomas
2007-12-06 15:38           ` tomas
2007-12-06 15:47             ` Reuben Thomas
2007-12-06 23:28               ` Juri Linkov
2007-12-06 23:44                 ` Reuben Thomas
2007-12-07  0:03                   ` Juri Linkov
2007-12-07  2:48                     ` Stefan Monnier
2007-12-09 20:35                     ` Reuben Thomas
2007-12-10  0:27                       ` Juri Linkov
2007-12-10  0:35                         ` Reuben Thomas
2007-12-10  0:50                           ` Drew Adams
2007-12-10  0:59                           ` Juri Linkov
2007-12-10  1:10                             ` Reuben Thomas
2007-12-10  3:03                         ` Stefan Monnier
2007-12-10 22:01                           ` Reuben Thomas
2007-12-10 23:55                             ` Juri Linkov
2007-12-11  0:10                               ` Reuben Thomas
2007-12-11  0:23                                 ` Juri Linkov
2007-12-11  0:42                                   ` Reuben Thomas
2013-04-10  1:36                                     ` Reuben Thomas
2013-04-10  7:05                                       ` Juri Linkov
2013-04-10 10:57                                         ` Reuben Thomas
2013-04-11  8:29                                           ` Juri Linkov [this message]
2013-04-11 11:04                                             ` Reuben Thomas
2013-04-27 20:57                                               ` Juri Linkov
2007-12-10 22:02                           ` Reuben Thomas
2007-12-10 22:12                             ` Drew Adams
2007-12-10 22:16                               ` Reuben Thomas
2007-12-10 23:57                                 ` Juri Linkov
2007-12-11  0:02                                   ` Reuben Thomas
2007-12-11  0:23                                     ` Juri Linkov
2007-12-11  0:48                                       ` Reuben Thomas
2007-12-11 19:01                                       ` Richard Stallman
2007-12-12  0:50                                         ` Reuben Thomas
2007-12-12 22:53                                           ` Richard Stallman
2007-12-12 23:59                                             ` Juri Linkov
2007-12-14 10:10                                               ` Richard Stallman
2007-12-07  2:47                 ` Stefan Monnier
2007-12-07 17:18             ` Richard Stallman
2007-12-03 21:14     ` Reuben Thomas
2007-12-03 22:57       ` Juri Linkov
2007-12-06 14:56         ` Reuben Thomas

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87k3o9v5bf.fsf@mail.jurta.org \
    --to=juri@jurta.org \
    --cc=emacs-devel@gnu.org \
    --cc=rrt@sc3d.org \
    --cc=tomas@tuxteam.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).