Fetching contributors…
Cannot retrieve contributors at this time
234 lines (185 sloc) 6.75 KB
;; Copyright (C) 2003-2008 Ivy Foster
;; This file is part of stumpwm.
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, see
;; <>.
;; Commentary:
;; This file contains code relating to the display of time.
;; When setting `*time-format-string-default*' to look like you want, the
;; options are exactly the same as those in the output of date --help (with date
;; 6.12), with the exception of a few unimplemented functions (see the comments
;; in *time-format-string-alist*, below). `*time-modeline-string*' is also
;; customizable; it defaults to the same value as *time-format-string-default*.
;; TODO:
;; - Implement all options from date.
;; - Simplify code (fewer helper functions somehow?)
;; Code:
(in-package :stumpwm)
(export '(*time-format-string-default*
(defvar *time-format-string-default* "%a %b %e %Y %k:%M:%S"
"The default value for `echo-date', (e.g, Thu Mar 3 2005 23:05:25).")
(defvar *time-modeline-string* "%a %b %e %k:%M:%S"
"The default time value to pass to the modeline.")
(defvar *time-month-names*
#("January" "February" "March" "April" "May" "June" "July" "August"
"September" "October" "November" "December"))
(defvar *time-day-names*
#("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"))
;; `date --help` with date_6.12
(defvar *time-format-string-alist*
'((#\a time-dow-shortname)
(#\A time-dow-name)
(#\b time-month-shortname)
(#\B time-month-name)
(#\c time-date-and-time)
(#\C time-century)
(#\d time-day-of-month)
(#\D time-date)
(#\e time-day-of-month-zero)
(#\F time-date-full)
;; (#\g) last two digits of year of ISO week number (see %G)
;; (#\G) year of ISO week number (see %V); normally useful only with %V
(#\h time-month-shortname)
(#\H time-hour-zero)
(#\I time-hour-12hr-zero)
;; (#\j) day of year (001..366)
(#\k time-hour)
(#\l time-hour-12hr)
(#\m time-month)
(#\M time-minute)
(#\n time-newline)
;; (#\N) nanoseconds (000000000..999999999)
(#\p time-am-pm)
(#\P time-am-pm-caps)
(#\r time-12hr-time)
(#\R time-24hr-and-minute)
(#\s time-unix-era)
(#\S time-second)
(#\t time-tab)
(#\T time-24hr-time)
(#\u time-day-of-week)
;; (#\U) week number of year, with Sunday as first day of week (00..53)
;; (#\V) ISO week number, with Monday as first day of week (01..53)
(#\w time-day-of-week-sun-start)
;; (#\W) week number of year, with Monday as first day of week (00..53)
;; (#\x) locale's date representation (e.g., 12/31/99)
;; (#\X) locale's time representation (e.g., 23:13:48)
(#\y time-year-short)
(#\Y time-year)
(#\z time-tz)
;; (#\:z) +hh:mm numeric timezone (e.g., -04:00)
;; (#\::z) +hh:mm:ss numeric time zone (e.g., -04:00:00)
;; (#\:::z) numeric time zone with : to necessary precision (e.g., -04, +05:30)
;; %Z alphabetic time zone abbreviation (e.g., EDT)
(defcommand echo-date () ()
"Display the date and time."
(message "~a" (time-format *time-format-string-default*)))
(defcommand-alias time echo-date)
;;; ------------------------------------------------------------------
;;; Helper functions
;;; ------------------------------------------------------------------
(defun time-plist (&optional time)
(multiple-value-bind (sec min hour dom mon year dow dstp tz)
(or time (get-decoded-time))
(list :second sec :minute min :hour hour :dom dom :month mon
:year year :dow dow :dlsavings-p dstp :tz tz)))
(defun time-second ()
(format nil "~2,'0D" (getf (time-plist) :second)))
(defun time-minute ()
(format nil "~2,'0D" (getf (time-plist) :minute)))
(defun time-hour ()
(format nil "~2,D" (getf (time-plist) :hour)))
(defun time-hour-zero ()
(format nil "~2,'0D" (getf (time-plist) :hour)))
(defun time-hour-12hr ()
(let ((hour (rem (getf (time-plist) :hour) 12)))
(format nil "~2,D"
(if (zerop hour) 12 hour))))
(defun time-hour-12hr-zero ()
(let ((hour (rem (getf (time-plist) :hour) 12)))
(format nil "~2,'0D"
(if (zerop hour) 12 hour))))
(defun time-day-of-month-zero ()
(format nil "~2,'0D" (getf (time-plist) :dom)))
(defun time-day-of-month ()
(format nil "~2,' D" (getf (time-plist) :dom)))
(defun time-month ()
(format nil "~2,'0D" (getf (time-plist) :month)))
(defun time-month-name ()
(aref *time-month-names* (1- (getf (time-plist) :month))))
(defun time-month-shortname ()
(subseq (time-month-name) 0 3))
(defun time-year ()
(write-to-string (getf (time-plist) :year)))
(defun time-century ()
(subseq (time-year) 0 2))
(defun time-year-short ()
(subseq (time-year) 2))
(defun time-day-of-week ()
(write-to-string (1+ (getf (time-plist) :dow))))
(defun time-day-of-week-sun-start ()
(let ((dow (getf (time-plist) :dow)))
(write-to-string (if (= dow 6) 0 (1+ dow)))))
(defun time-dow-name ()
(aref *time-day-names* (getf (time-plist) :dow)))
(defun time-dow-shortname ()
(subseq (time-dow-name) 0 3))
(defun time-newline ()
(format nil "~a" #\newline))
(defun time-tab ()
(format nil "~T"))
(defun time-am-pm ()
(if (>= (getf (time-plist) :hour) 12)
"pm" "am"))
(defun time-am-pm-caps ()
(if (>= (getf (time-plist) :hour) 12)
"PM" "AM"))
(defun time-tz ()
(let ((tz (getf (time-plist) :tz))
(dlsave (if (getf (time-plist) :dlsavings-p) 1 0)))
(multiple-value-bind (hour-local decimal-local)
(truncate (+ (* (float tz) -1)
(if dlsave 1 0)))
(format nil "~A~2,'0D~2,'0D"
(if (> hour-local 0) '+ '-)
(abs hour-local)
(truncate (if (/= decimal-local 0)
(* 60 decimal-local) 0))))))
(defun time-unix-era ()
(format nil "~D"
(- (get-universal-time)
(encode-universal-time 0 0 0 1 1 1970 0))))
(defun time-date-and-time ()
(time-format "%a %h %d %H:%M:%S %Y"))
(defun time-date ()
(time-format "%m/%d/%y"))
(defun time-date-full ()
(time-format "%Y-%m-%d"))
(defun time-12hr-time ()
(time-format "%I:%M:%S %P"))
(defun time-24hr-and-minute ()
(time-format "%H:%M"))
(defun time-24hr-time ()
(time-format "%H:%M:%S"))
(defun time-format (str)
(format-expand *time-format-string-alist* str))
;;; End of file