- (let ((filename (desktop-full-file-name dirname))
- (info
- (mapcar
- #'(lambda (b)
- (set-buffer b)
- (list
- (desktop-file-name (buffer-file-name) dirname)
- (buffer-name)
- major-mode
- ;; minor modes
- (let (ret)
- (mapc
- #'(lambda (minor-mode)
- (and
- (boundp minor-mode)
- (symbol-value minor-mode)
- (let* ((special (assq minor-mode desktop-minor-mode-table))
- (value (cond (special (cadr special))
- ((functionp minor-mode) minor-mode))))
- (when value (add-to-list 'ret value)))))
- (mapcar #'car minor-mode-alist))
- ret)
- (point)
- (list (mark t) mark-active)
- buffer-read-only
- ;; Auxiliary information
- (when (functionp desktop-save-buffer)
- (funcall desktop-save-buffer dirname))
- (let ((locals desktop-locals-to-save)
- (loclist (buffer-local-variables))
- (ll))
- (while locals
- (let ((here (assq (car locals) loclist)))
- (if here
- (setq ll (cons here ll))
- (when (member (car locals) loclist)
- (setq ll (cons (car locals) ll)))))
- (setq locals (cdr locals)))
- ll)))
- (buffer-list)))
- (eager desktop-restore-eager))
- (with-temp-buffer
- (insert
- ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
- desktop-header
- ";; Created " (current-time-string) "\n"
- ";; Desktop file format version " desktop-file-version "\n"
- ";; Emacs version " emacs-version "\n\n"
- ";; Global section:\n")
- (mapc (function desktop-outvar) desktop-globals-to-save)
- (if (memq 'kill-ring desktop-globals-to-save)
- (insert
- "(setq kill-ring-yank-pointer (nthcdr "
- (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
- " kill-ring))\n"))
-
- (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
- (mapc #'(lambda (l)
- (when (apply 'desktop-save-buffer-p l)
- (insert "("
- (if (or (not (integerp eager))
- (unless (zerop eager)
- (setq eager (1- eager))
- t))
- "desktop-create-buffer"
- "desktop-append-buffer-args")
- " "
- desktop-file-version)
- (mapc #'(lambda (e)
- (insert "\n " (desktop-value-to-string e)))
- l)
- (insert ")\n\n")))
- info)
- (setq default-directory dirname)
- (let ((coding-system-for-write 'emacs-mule))
- (write-region (point-min) (point-max) filename nil 'nomessage)))))
- (setq desktop-dirname dirname))
+ (let ((eager desktop-restore-eager)
+ (new-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
+ (when
+ (or (not new-modtime) ; nothing to overwrite
+ (equal desktop-file-modtime new-modtime)
+ (yes-or-no-p (if desktop-file-modtime
+ (if (> (float-time new-modtime) (float-time desktop-file-modtime))
+ "Desktop file is more recent than the one loaded. Save anyway? "
+ "Desktop file isn't the one loaded. Overwrite it? ")
+ "Current desktop was not loaded from a file. Overwrite this desktop file? "))
+ (unless release (error "Desktop file conflict")))
+
+ ;; If we're done with it, release the lock.
+ ;; Otherwise, claim it if it's unclaimed or if we created it.
+ (if release
+ (desktop-release-lock)
+ (unless (and new-modtime (desktop-owner)) (desktop-claim-lock)))
+
+ (with-temp-buffer
+ (insert
+ ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
+ desktop-header
+ ";; Created " (current-time-string) "\n"
+ ";; Desktop file format version " desktop-file-version "\n"
+ ";; Emacs version " emacs-version "\n")
+ (save-excursion (run-hooks 'desktop-save-hook))
+ (goto-char (point-max))
+ (insert "\n;; Global section:\n")
+ (mapc (function desktop-outvar) desktop-globals-to-save)
+ (when (memq 'kill-ring desktop-globals-to-save)
+ (insert
+ "(setq kill-ring-yank-pointer (nthcdr "
+ (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
+ " kill-ring))\n"))
+
+ (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
+ (dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
+ (let ((base (pop l)))
+ (when (apply 'desktop-save-buffer-p l)
+ (insert "("
+ (if (or (not (integerp eager))
+ (if (zerop eager)
+ nil
+ (setq eager (1- eager))))
+ "desktop-create-buffer"
+ "desktop-append-buffer-args")
+ " "
+ desktop-file-version)
+ ;; If there's a non-empty base name, we save it instead of the buffer name
+ (when (and base (not (string= base "")))
+ (setcar (nthcdr 1 l) base))
+ (dolist (e l)
+ (insert "\n " (desktop-value-to-string e)))
+ (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)))))))))