Function: desktop--v2s

desktop--v2s is a byte-compiled function defined in desktop.el.gz.

Signature

(desktop--v2s VALUE)

Documentation

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).

Source Code

;; Defined in /usr/src/emacs/lisp/desktop.el.gz
;; ----------------------------------------------------------------------------
(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 value))
    ((stringp value)
     ;; Get rid of unreadable text properties.
     (if (condition-case nil (read (format "%S" value)) (error nil))
         (cons 'may value)
       (let ((copy (copy-sequence value)))
         (set-text-properties 0 (length copy) nil copy)
         (cons 'may copy))))
    ((symbolp value)
     (cons 'must value))
    ((vectorp value)
     (let* ((pass1 (mapcar #'desktop--v2s value))
	    (special (assq nil pass1)))
       (if special
	   (cons nil `(vector
                       ,@(mapcar (lambda (el)
                                   (if (eq (car el) 'must)
                                       `',(cdr el) (cdr el)))
                                 pass1)))
	 (cons 'may `[,@(mapcar #'cdr pass1)]))))
    ((and (recordp value) (symbolp (aref value 0)))
     (let* ((pass1 (let ((res ()))
                     (dotimes (i (length value))
                       (push (desktop--v2s (aref value i)) res))
                     (nreverse res)))
	    (special (assq nil pass1)))
       (if special
	   (cons nil `(record
                       ,@(mapcar (lambda (el)
                                   (if (eq (car el) 'must)
                                       `',(cdr el) (cdr el)))
                                 pass1)))
	 (cons 'may (apply #'record (mapcar #'cdr pass1))))))
    ((consp value)
     (let ((p value)
	   newlist
	   use-list*)
       (while (consp p)
	 (let ((q.sexp (desktop--v2s (car p))))
           (push q.sexp newlist))
	 (setq p (cdr p)))
       (when p
         (let ((last (desktop--v2s p)))
           (setq use-list* t)
           (push last newlist)))
       (if (assq nil newlist)
	   (cons nil
		 `(,(if use-list* 'desktop-list* 'list)
                   ,@(mapcar (lambda (el)
                               (if (eq (car el) 'must)
                                   `',(cdr el) (cdr el)))
                             (nreverse newlist))))
	 (cons 'must
	       `(,@(mapcar #'cdr
                           (nreverse (if use-list* (cdr newlist) newlist)))
                 . ,(if use-list* (cdar newlist)))))))
    ((subrp value)
     (cons nil `(symbol-function
                 ',(intern-soft (substring (prin1-to-string value) 7 -1)))))
    ((markerp value)
     (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"))))