Function: with-decoded-time-value

with-decoded-time-value is a macro defined in time-date.el.gz.

This macro is obsolete since 25.1.

Signature

(with-decoded-time-value VARLIST &rest BODY)

Documentation

Decode a time value and bind it according to VARLIST, then eval BODY.

The value of the last form in BODY is returned.

Each element of the list VARLIST is a list of the form
(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE).
The time value TIME-VALUE is decoded and the result is bound to the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL. The optional PICO-SYMBOL is bound to the picoseconds part.

The optional TYPE-SYMBOL is bound to the type of the time value. Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the list (HIGH LOW MICRO PICO).

Probably introduced at or before Emacs version 25.1.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/time-date.el.gz
(defmacro with-decoded-time-value (varlist &rest body)
  "Decode a time value and bind it according to VARLIST, then eval BODY.

The value of the last form in BODY is returned.

Each element of the list VARLIST is a list of the form
\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE).
The time value TIME-VALUE is decoded and the result is bound to
the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
The optional PICO-SYMBOL is bound to the picoseconds part.

The optional TYPE-SYMBOL is bound to the type of the time value.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the
list (HIGH LOW MICRO PICO)."
  (declare (indent 1)
	   (debug ((&rest (symbolp symbolp symbolp
                           &or [symbolp symbolp form] [symbolp form] form))
		   body)))
  (if varlist
      (let* ((elt (pop varlist))
	     (high (pop elt))
	     (low (pop elt))
	     (micro (pop elt))
	     (pico (unless (<= (length elt) 2)
		     (pop elt)))
	     (type (unless (eq (length elt) 1)
		     (pop elt)))
	     (time-value (car elt))
	     (gensym (make-symbol "time")))
	`(let* ,(append `((,gensym (or ,time-value (time-convert nil 'list)))
			  (,gensym
			   (cond
			    ((integerp ,gensym)
			     (list (ash ,gensym -16)
				   (logand ,gensym 65535)))
			    ((floatp ,gensym)
			     (let* ((usec (* 1000000 (mod ,gensym 1)))
				    (ps (round (* 1000000 (mod usec 1))))
				    (us (floor usec))
				    (lo (floor (mod ,gensym 65536)))
				    (hi (floor ,gensym 65536)))
			       (if (eq ps 1000000)
				   (progn
				     (setq ps 0)
				     (setq us (1+ us))
				     (if (eq us 1000000)
					 (progn
					   (setq us 0)
					   (setq lo (1+ lo))
					   (if (eq lo 65536)
					       (progn
						 (setq lo 0)
						 (setq hi (1+ hi))))))))
			       (list hi lo us ps)))
			    (t ,gensym)))
			  (,high (pop ,gensym))
			  ,low ,micro)
			(when pico `(,pico))
			(when type `(,type)))
	   (if (consp ,gensym)
	       (progn
		 (setq ,low (pop ,gensym))
		 (if ,gensym
		     (progn
		       (setq ,micro (car ,gensym))
		       ,(cond (pico
			       `(if (cdr ,gensym)
				    ,(append `(setq ,pico (cadr ,gensym))
					     (when type `(,type 3)))
				  ,(append `(setq ,pico 0)
					   (when type `(,type 2)))))
			      (type
			       `(setq type 2))))
		   ,(append `(setq ,micro 0)
			    (when pico `(,pico 0))
			    (when type `(,type 1)))))
	     ,(append `(setq ,low ,gensym ,micro 0)
		      (when pico `(,pico 0))
		      (when type `(,type 0))))
	   (with-decoded-time-value ,varlist ,@body)))
    `(progn ,@body)))