From 69b2c07eaf592dee54ccd9bdb5f38dce88d1f221 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Mar 2013 23:38:18 -0400 Subject: [PATCH] * lisp/desktop.el (desktop--v2s): Rename from desktop-internal-v2s. Change return value to be a sexp. Delay `get-buffer' to after restoring the desktop. Fixes: debbugs:13951 --- lisp/ChangeLog | 6 ++++ lisp/desktop.el | 106 +++++++++++++++++++++++++------------------------------- 2 files changed, 53 insertions(+), 59 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3f7e3efa424..e86bc7f0a96 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2013-03-26 Stefan Monnier + + * desktop.el (desktop--v2s): Rename from desktop-internal-v2s. + Change return value to be a sexp. Delay `get-buffer' to after + restoring the desktop (bug#13951). + 2013-03-26 Leo Liu * register.el: Move semantic tag handling back to diff --git a/lisp/desktop.el b/lisp/desktop.el index 1151bd434bc..9c95f597fff 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -697,83 +697,69 @@ is nil, ask the user where to save the desktop." ll))) ;; ---------------------------------------------------------------------------- -(defun desktop-internal-v2s (value) - "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. -TXT is a string that when read and evaluated yields VALUE. +(defun desktop--v2s (value) + "Convert VALUE to a pair (QUOTE . SEXP); (eval SEXP) gives VALUE. +SEXP is an sexp that when evaluated yields VALUE. QUOTE may be `may' (value may be quoted), `must' (value must be quoted), or nil (value must not be quoted)." (cond ((or (numberp value) (null value) (eq t value) (keywordp value)) - (cons 'may (prin1-to-string value))) + (cons 'may value)) ((stringp value) (let ((copy (copy-sequence value))) (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) + ;; Get rid of text properties because we cannot read them. + (cons 'may copy))) ((symbolp value) - (cons 'must (prin1-to-string value))) + (cons 'must value)) ((vectorp value) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - value))) + (let* ((pass1 (mapcar #'desktop--v2s value)) + (special (assq nil pass1))) (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) + (cons nil `(vector + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + pass1))) + (cons 'may `[,@(mapcar #'cdr pass1)])))) ((consp value) (let ((p value) newlist use-list* anynil) (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) + (let ((q.sexp (desktop--v2s (car p)))) + (push q.sexp newlist)) (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil + (when p + (let ((last (desktop--v2s p))) + (setq use-list* t) + (push last newlist))) + (if (assq nil newlist) (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) + `(,(if use-list* 'desktop-list* 'list) + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + (nreverse newlist)))) (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) + `(,@(mapcar #'cdr + (nreverse (if use-list* (cdr newlist) newlist))) + ,@(if use-list* (cdar newlist))))))) ((subrp value) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string value) 7 -1) - ")"))) + (cons nil `(symbol-function + ',(intern-soft (substring (prin1-to-string value) 7 -1))))) ((markerp value) - (let ((pos (prin1-to-string (marker-position value))) - (buf (prin1-to-string (buffer-name (marker-buffer value))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) + (let ((pos (marker-position value)) + (buf (buffer-name (marker-buffer value)))) + (cons nil + `(let ((mk (make-marker))) + (add-hook 'desktop-delay-hook + `(lambda () + (set-marker ,mk ,,pos (get-buffer ,,buf)))) + mk)))) + (t ; Save as text. + (cons 'may "Unprintable entity")))) ;; ---------------------------------------------------------------------------- (defun desktop-value-to-string (value) @@ -781,9 +767,11 @@ QUOTE may be `may' (value may be quoted), Not all types of values are supported." (let* ((print-escape-newlines t) (float-output-format nil) - (quote.txt (desktop-internal-v2s value)) - (quote (car quote.txt)) - (txt (cdr quote.txt))) + (quote.sexp (desktop--v2s value)) + (quote (car quote.sexp)) + (txt + (let ((print-quoted t)) + (prin1-to-string (cdr quote.sexp))))) (if (eq quote 'must) (concat "'" txt) txt))) -- 2.11.4.GIT