Commit b4929f75 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(desktop-internal-v2s): Default case fixed to return correct quote flag.

Fix cons cell handling to avoid recursion in the cdr part.
parent 2c81f22c
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk> ;; Author: Morten Welinder <terra@diku.dk>
;; Version: 2.07 ;; Version: 2.08
;; Keywords: customization ;; Keywords: customization
;; Favourite-brand-of-beer: None, I hate beer. ;; Favourite-brand-of-beer: None, I hate beer.
...@@ -218,22 +218,42 @@ and evaluated yields value. quote may be 'may (value may be quoted), ...@@ -218,22 +218,42 @@ and evaluated yields value. quote may be 'may (value may be quoted),
")")) ")"))
(cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
((consp val) ((consp val)
(let ((car-q.txt (desktop-internal-v2s (car val))) (let ((p val)
(cdr-q.txt (desktop-internal-v2s (cdr val)))) newlist
(cond anynil)
((or (null (car car-q.txt)) (null (car cdr-q.txt))) (while (consp p)
(cons nil (concat "(cons " (let ((q.txt (desktop-internal-v2s (car p))))
(if (eq (car car-q.txt) 'must) "'") (or anynil (setq anynil (null (car q.txt))))
(cdr car-q.txt) " " (setq newlist (cons q.txt newlist)))
(if (eq (car cdr-q.txt) 'must) "'") (setq p (cdr p)))
(cdr cdr-q.txt) ")"))) (if p
((consp (cdr val)) (let ((last (desktop-internal-v2s p))
(cons 'must (concat "(" (cdr car-q.txt) (el (car newlist)))
" " (substring (cdr cdr-q.txt) 1 -1) ")"))) (setcar newlist
((null (cdr val)) (if (or anynil (setq anynil (null (car last))))
(cons 'must (concat "(" (cdr car-q.txt) ")"))) (cons nil
(t (concat "(cons "
(cons 'must (concat "(" (cdr car-q.txt) " . " (cdr cdr-q.txt) ")")))))) (if (eq (car el) 'must) "'" "")
(cdr el)
" "
(if (eq (car last) 'must) "'" "")
(cdr last)
")"))
(cons 'must
(concat (cdr el) " . " (cdr last)))))))
(setq newlist (nreverse newlist))
(if anynil
(cons nil
(concat "(list "
(mapconcat (lambda (el)
(if (eq (car el) 'must)
(concat "'" (cdr el))
(cdr el)))
newlist
" ")
")"))
(cons 'must
(concat "(" (mapconcat 'cdr newlist " ") ")")))))
((subrp val) ((subrp val)
(cons nil (concat "(symbol-function '" (cons nil (concat "(symbol-function '"
(substring (prin1-to-string val) 7 -1) (substring (prin1-to-string val) 7 -1)
...@@ -246,7 +266,7 @@ and evaluated yields value. quote may be 'may (value may be quoted), ...@@ -246,7 +266,7 @@ and evaluated yields value. quote may be 'may (value may be quoted),
" (list 'lambda '() (list 'set-marker mk " " (list 'lambda '() (list 'set-marker mk "
pos " (get-buffer " buf ")))) mk)")))) pos " (get-buffer " buf ")))) mk)"))))
(t ; save as text (t ; save as text
(cons nil (prin1-to-string (prin1-to-string val)))))) (cons 'may (prin1-to-string val)))))
(defun desktop-value-to-string (val) (defun desktop-value-to-string (val)
"Convert VALUE to a string that when read evaluates to the same value. Not "Convert VALUE to a string that when read evaluates to the same value. Not
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment