[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] refs/scratch/raeburn/startup 87446c4 1/5: Stefan's patch t
From: |
Ken Raeburn |
Subject: |
[Emacs-diffs] refs/scratch/raeburn/startup 87446c4 1/5: Stefan's patch to write out 'dumped.elc'. |
Date: |
Sun, 30 Oct 2016 14:16:47 +0000 (UTC) |
reference: refs/scratch/raeburn/startup
commit 87446c4214e34025f6d25582e5cf6202de819a88
Author: Ken Raeburn <address@hidden>
Commit: Ken Raeburn <address@hidden>
Stefan's patch to write out 'dumped.elc'.
---
lisp/loadup.el | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 59 insertions(+)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 5c16464..0a1c366 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -474,6 +474,65 @@ lost after dumping")))
invocation-directory)
(expand-file-name name invocation-directory)
t)))
+ (message "Dumping into dumped.elc...preparing...")
+
+ ;; Dump the current state into a file so we can reload it!
+ (with-current-buffer (generate-new-buffer "dumped.elc")
+ (message "Dumping into dumped.elc...generating...")
+ (insert ";address@hidden@address@hidden;;; Compiled\n;;; in Emacs
version " emacs-version "\n")
+ (let ((cmds '()))
+ (setcdr global-buffers-menu-map nil) ;; Get rid of buffer objects!
+ (mapatoms
+ (lambda (s)
+ (when (and (fboundp s)
+ (not (subrp (symbol-function s)))
+ ;; FIXME: We need these, but they contain
+ ;; unprintable objects.
+ (not (memq s '(rename-buffer))))
+ (push `(fset ',s ,(macroexp-quote (symbol-function s))) cmds))
+ (when (and (boundp s) (not (keywordp s))
+ (not (memq s '(nil t
+ ;; I think we don't need these!
+ terminal-frame
+ ;; FIXME: We need these, but they
contain
+ ;; unprintable objects.
+ advertised-signature-table
+
undo-auto--undoably-changed-buffers))))
+ ;; FIXME: Don't record in the load-history!
+ ;; FIXME: Handle varaliases!
+ (let ((v (symbol-value s)))
+ (push `(defvar ,s
+ ,(cond
+ ((subrp v)
+ `(symbol-function ',(intern (subr-name v))))
+ ((and (markerp v) (null (marker-buffer v)))
+ '(make-marker))
+ ((and (overlayp v) (null (overlay-buffer v)))
+ '(let ((ol (make-overlay (point-min)
(point-min))))
+ (delete-overlay ol)
+ ol))
+ (v (macroexp-quote v))))
+ cmds)))
+ (when (symbol-plist s)
+ (push `(setplist ',s ',(symbol-plist s)) cmds))))
+ (message "Dumping into dumped.elc...printing...")
+ (let ((print-circle t)
+ (print-gensym t)
+ (print-quoted t)
+ (print-level nil)
+ (print-length nil)
+ (print-escape-newlines t))
+ (print `(progn . ,cmds) (current-buffer)))
+ (goto-char (point-min))
+ (while (re-search-forward " (\\(defvar\\|setplist\\|fset\\) " nil t)
+ (goto-char (match-beginning 0))
+ (delete-char 1) (insert "\n"))
+ (message "Dumping into dumped.elc...saving...")
+ (let ((coding-system-for-write 'emacs-internal))
+ (write-region (point-min) (point-max) (buffer-name)))
+ (message "Dumping into dumped.elc...done")
+ ))
+
(kill-emacs)))
;; For machines with CANNOT_DUMP defined in config.h,