cf921bd862
We still don't support POSIX timezone descriptions and the like, but I currently don't have the energy to support something just for POSIX's sake. Change-Id: Ifbfc798ebe849e886cc31964b7fbc70ff009ef29 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3167 Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI
91 lines
3 KiB
Common Lisp
91 lines
3 KiB
Common Lisp
(defpackage 🕰️.bin
|
||
(:shadow :describe)
|
||
(:use :cl :opts)
|
||
(:import-from :uiop :quit)
|
||
(:import-from :local-time
|
||
:now :timestamp-subtimezone :+utc-zone+
|
||
:*default-timezone* :define-timezone)
|
||
(:import-from :klatre :format-dottime-offset)
|
||
(:import-from :🕰️ :⌚)
|
||
(:export :🚂))
|
||
|
||
(in-package :🕰️.bin)
|
||
(declaim (optimize (safety 3)))
|
||
|
||
(opts:define-opts
|
||
(:name :help
|
||
:description "Print this help text"
|
||
:short #\h
|
||
:long "help")
|
||
(:name :dot-time
|
||
:description "Use pseudo dot-time format (implies -u)"
|
||
:short #\d
|
||
:long "dot-time")
|
||
(:name :utc
|
||
:description "Display time in UTC instead of local time"
|
||
:short #\u
|
||
:long "utc")
|
||
(:name :no-newline
|
||
:description "Don't print a trailing newline"
|
||
:short #\n
|
||
:long "no-newline"))
|
||
|
||
(defun make-slash-terminated (str)
|
||
(if (eq (char str (1- (length str))) #\/)
|
||
str
|
||
(concatenate 'string str "/")))
|
||
|
||
; TODO(sterni): upstream this into local-time
|
||
(defun setup-default-timezone ()
|
||
(let* ((tz (remove #\: (uiop:getenv "TZ") :count 1))
|
||
(tz-dir (uiop:getenv "TZDIR"))
|
||
(tz-file (if (and tz tz-dir)
|
||
(merge-pathnames
|
||
(pathname tz)
|
||
(pathname (make-slash-terminated tz-dir)))
|
||
(pathname "/etc/localtime"))))
|
||
(handler-case
|
||
(define-timezone *default-timezone* tz-file :load t)
|
||
(t () (setf *default-timezone* +utc-zone+)))))
|
||
|
||
|
||
(defun 🚂 ()
|
||
(let ((ts (now)))
|
||
(multiple-value-bind (options free-args)
|
||
(handler-case (opts:get-opts)
|
||
; only handle subset of conditions that can happen here
|
||
(opts:unknown-option (c)
|
||
(format t "error: unknown option ~s~%" (opts:option c))
|
||
(quit 100)))
|
||
|
||
; check if we have any free args we don't know what to do with
|
||
(when (> (length free-args) 0)
|
||
(write-string "error: unexpected command line argument(s): ")
|
||
(loop for arg in free-args
|
||
do (progn (write-string arg) (write-char #\space)))
|
||
(write-char #\newline)
|
||
(quit 100))
|
||
|
||
; print help and exit
|
||
(when (getf options :help)
|
||
(opts:describe :usage-of "🕰️")
|
||
(quit 0))
|
||
|
||
; reinit *default-timezone* as it is cached from compilation
|
||
(setup-default-timezone)
|
||
; dot-time implies UTC, naturally
|
||
(when (getf options :dot-time)
|
||
(setf (getf options :utc) t))
|
||
; print clock face
|
||
(format t "~A" (⌚ ts (if (getf options :utc)
|
||
local-time:+utc-zone+
|
||
local-time:*default-timezone*)))
|
||
; render dot-time offset if necessary
|
||
(when (getf options :dot-time)
|
||
(multiple-value-bind (offset-secs _dst _name)
|
||
(timestamp-subtimezone ts local-time:*default-timezone*)
|
||
(write-string
|
||
(format-dottime-offset (round (/ offset-secs 3600))))))
|
||
; write newline if necessary
|
||
(when (not (getf options :no-newline))
|
||
(write-char #\newline)))))
|