about summary refs log tree commit diff
path: root/third_party/lisp/trivial-backtrace/dev/utilities.lisp
blob: b0a249867aa990956b42649016676db8c7535b03 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
(in-package #:trivial-backtrace)

(defparameter *date-time-format* "%Y-%m-%d-%H:%M"
  "The default format to use when printing dates and times.

* %% - A '%' character
* %d - Day of the month as a decimal number [01-31]
* %e - Same as %d but does not print the leading 0 for days 1 through 9 
     [unlike strftime[], does not print a leading space]
* %H - Hour based on a 24-hour clock as a decimal number [00-23]
*%I - Hour based on a 12-hour clock as a decimal number [01-12]
* %m - Month as a decimal number [01-12]
* %M - Minute as a decimal number [00-59]
* %S - Second as a decimal number [00-59]
* %w - Weekday as a decimal number [0-6], where Sunday is 0
* %y - Year without century [00-99]
* %Y - Year with century [such as 1990]

This code is borrowed from the `format-date` function in 
[metatilities-base][].")

;; modified from metatilities-base
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro generate-time-part-function (part-name position)
    (let ((function-name 
	   (intern 
	    (concatenate 'string
			 (symbol-name 'time) "-" (symbol-name part-name))
	    :trivial-backtrace)))
      `(eval-when (:compile-toplevel :load-toplevel :execute)
         (defun ,function-name
                (&optional (universal-time (get-universal-time))
                           (time-zone nil))
           ,(format nil "Returns the ~(~A~) part of the given time." part-name)
           (nth-value ,position 
		      (apply #'decode-universal-time
			     universal-time time-zone))))))

  (generate-time-part-function second 0)
  (generate-time-part-function minute 1)
  (generate-time-part-function hour 2)
  (generate-time-part-function date 3)
  (generate-time-part-function month 4)
  (generate-time-part-function year 5)
  (generate-time-part-function day-of-week 6)
  (generate-time-part-function daylight-savings-time-p 7))

(defun date-time-string (&key (date/time (get-universal-time))
			 (format *date-time-format*))
  (format-date format date/time nil))

(defun format-date (format date &optional stream time-zone)
  (declare (ignore time-zone))
  (let ((format-length (length format)))
    (format 
     stream "~{~A~}"
     (loop for index = 0 then (1+ index) 
	while (< index format-length) collect 
	(let ((char (aref format index)))
	  (cond 
	    ((char= #\% char)
	     (setf char (aref format (incf index)))
	     (cond 
	       ;; %% - A '%' character
	       ((char= char #\%) #\%)
                            
	       ;; %d - Day of the month as a decimal number [01-31]
	       ((char= char #\d) (format nil "~2,'0D" (time-date date)))
                            
	       ;; %e - Same as %d but does not print the leading 0 for 
	       ;; days 1 through 9. Unlike strftime, does not print a 
	       ;; leading space
	       ((char= char #\e) (format nil "~D" (time-date date)))
                            
	       ;; %H - Hour based on a 24-hour clock as a decimal number [00-23]
	       ((char= char #\H) (format nil "~2,'0D" (time-hour date)))
                            
	       ;; %I - Hour based on a 12-hour clock as a decimal number [01-12]
	       ((char= char #\I) (format nil "~2,'0D" 
					 (1+ (mod (time-hour date) 12))))
                            
	       ;; %m - Month as a decimal number [01-12]
	       ((char= char #\m) (format nil "~2,'0D" (time-month date)))
                            
	       ;; %M - Minute as a decimal number [00-59]
	       ((char= char #\M) (format nil "~2,'0D" (time-minute date)))
                            
	       ;; %S - Second as a decimal number [00-59]
	       ((char= char #\S) (format nil "~2,'0D" (time-second date)))
                            
	       ;; %w - Weekday as a decimal number [0-6], where Sunday is 0
	       ((char= char #\w) (format nil "~D" (time-day-of-week date)))
                            
	       ;; %y - Year without century [00-99]
	       ((char= char #\y) 
		(let ((year-string (format nil "~,2A" (time-year date))))
		  (subseq year-string (- (length year-string) 2))))
                            
	       ;; %Y - Year with century [such as 1990]
	       ((char= char #\Y) (format nil "~D" (time-year date)))
                            
	       (t
		(error "Ouch - unknown formatter '%~c" char))))
	    (t char)))))))