>From 59852228df4ea98376ce3695b8363152ac62da6a Mon Sep 17 00:00:00 2001 From: Ivy Foster Date: Wed, 22 Oct 2008 17:44:10 -0500 Subject: [PATCH] Added time.lisp - Output should be identical to previous time code - Works with (format-expand) instead of (time-lambda) - Added modeline support - *All* time commands and variables now begin with time- or *time-. If you customize *format-time-string-default*, do change the first two words. --- Makefile.in | 6 +- stumpwm.asd | 1 + time.lisp | 239 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ user.lisp | 129 ------------------------------ version.lisp.in | 5 +- 5 files changed, 247 insertions(+), 133 deletions(-) create mode 100644 time.lisp diff --git a/Makefile.in b/Makefile.in index 8495e72..232b3be 100644 --- a/Makefile.in +++ b/Makefile.in @@ -21,9 +21,9 @@ address@hidden@ FILES=package.lisp primitives.lisp wrappers.lisp keysyms.lisp \ keytrans.lisp kmap.lisp input.lisp core.lisp command.lisp menu.lisp \ screen.lisp group.lisp frame.lisp window.lisp message-window.lisp \ -events.lisp selection.lisp user.lisp iresize.lisp bindings.lisp \ -help.lisp fdump.lisp mode-line.lisp color.lisp stumpwm.lisp \ -version.lisp +events.lisp selection.lisp user.lisp iresize.lisp \ +bindings.lisp help.lisp fdump.lisp mode-line.lisp time.lisp color.lisp \ +stumpwm.lisp version.lisp all: stumpwm.info stumpwm diff --git a/stumpwm.asd b/stumpwm.asd index df17301..9626a80 100644 --- a/stumpwm.asd +++ b/stumpwm.asd @@ -48,6 +48,7 @@ (:file "help") (:file "fdump") (:file "mode-line") + (:file "time") (:file "color") (:file "module") (:file "stumpwm") diff --git a/time.lisp b/time.lisp new file mode 100644 index 0000000..8509730 --- /dev/null +++ b/time.lisp @@ -0,0 +1,239 @@ +;; 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 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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, write to +;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;; Boston, MA 02111-1307 USA + +;; 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* + *time-modeline-string* + echo-date + time)) + +(defvar *time-format-string-default* "%a %b %e %k:%M:%S" + "The default value for `echo-date', (e.g, Thu Mar 3 23:05:25 2005).") + +(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")) + +(defcommand echo-date () () + "Display the date and time." + (message "~a" (format-expand *time-format-string-alist* + *time-format-string-default*))) + +(defcommand-alias time echo-date) + +(defun time-modeline (ml) + (declare (ignore ml)) + (format-expand *time-format-string-alist* *time-modeline-string*)) + +(dolist (a '((#\d time-modeline))) + (pushnew a *screen-mode-line-formatters* :test 'equal)) + +;; `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) + (#\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) + )) + +;;; ------------------------------------------------------------------ +;;; Helper functions +;;; ------------------------------------------------------------------ + +(defun time-plist (&optional time) + (setf *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 () + (format-expand *time-format-string-alist* "%a %h %d %H:%M:%S %Y")) + +(defun time-date () + (format-expand *time-format-string-alist* "%m/%d/%y")) + +(defun time-date-full () + (format-expand *time-format-string-alist* "%Y-%m-%d")) + +(defun time-12hr-time () + (format-expand *time-format-string-alist* "%I:%m:%S %P")) + +(defun time-24hr-and-minute () + (format-expand *time-format-string-alist* "%H:%m")) + +(defun time-24hr-time () + (format-expand *time-format-string-alist* "%H:%m:%S")) + +;;; End of file diff --git a/user.lisp b/user.lisp index 8b08b9b..469fe30 100644 --- a/user.lisp +++ b/user.lisp @@ -104,135 +104,6 @@ menu, the error is re-signalled." (when (current-window) (send-fake-click (current-window) button))) -;;; (format-time-stringc ...) section -(defmacro time-lambda (used-var &body body) - `(lambda (sec min hour dom mon year dow dstp tz) - (declare (ignore ,@(set-difference '(sec min hour dom mon year dow dstp tz) used-var))) - ,@body)) - -(defvar *month-names* - #("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) - -(defvar *day-names* - #("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")) - -;; `date --help` with date_5.97 -;; `date --help` with date_5.97 -(defvar *format-time-string-alist* - `((#\% . ,(time-lambda () "%")) - (#\a . ,(time-lambda (dow) (subseq (aref *day-names* dow) 0 3))) - (#\A . ,(time-lambda (dow) (aref *day-names* dow))) - (#\b . ,(time-lambda (mon) (subseq (aref *month-names* (- mon 1)) 0 3))) - (#\B . ,(time-lambda (mon) (aref *month-names* (- mon 1)))) - (#\c . ,(time-lambda (dow mon dom hour min sec year) - (format nil "~A ~A ~2,'0D ~2,'0D:~2,'0D:~2,'0D ~D" - (subseq (aref *day-names* dow) 0 3) - (subseq (aref *month-names* (- mon 1)) 0 3) - dom hour min sec year))) - (#\C . ,(time-lambda (year) (subseq (format nil "~D" year) 0 2))) - (#\d . ,(time-lambda (dom) (format nil "~2,'0D" dom))) - (#\D . ,(time-lambda (mon dom year) - (format nil "~2,'0D/~2,'0D/~A" - mon dom (subseq (format nil "~D" year) 2 4)))) - (#\e . ,(time-lambda (dom) (format nil "~2,' D" dom))) - (#\F . ,(time-lambda (year mon dom) (format nil "~D-~2,'0D-~2,'0D" year mon dom))) - ;; %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-lambda (mon) (subseq (aref *month-names* (- mon 1)) 0 3))) - (#\H . ,(time-lambda (hour) (format nil "~2,'0D" hour))) - (#\I . ,(time-lambda (hour) - (format nil "~2,'0D" (if (> hour 12) (- hour 12) (if (zerop hour) 12 hour))))) - ;; %j day of year (001..366) - (#\k . ,(time-lambda (hour) (format nil "~2,D" hour))) - (#\l . ,(time-lambda (hour) - (format nil "~2,D" (if (> hour 12) (- hour 12) (if (zerop hour) 12 hour))))) - (#\m . ,(time-lambda (mon) (format nil "~2,'0D" mon))) - (#\M . ,(time-lambda (min) (format nil "~2,'0D" min))) - (#\n . ,(time-lambda () "~%%")) ;; two % to avoid parsing errors - ;; %N nanoseconds (000000000..999999999) - (#\p . ,(time-lambda (hour) (if (>= hour 12) "PM" "AM"))) - (#\P . ,(time-lambda (hour) (if (>= hour 12) "pm" "am"))) - (#\r . ,(time-lambda (hour min sec) - (let (hour-local am-pm) - (cond - ((> hour 12) - (setf hour-local (- hour 12) am-pm "PM")) - ((= hour 12) - (setf hour-local hour am-pm "PM")) - (t - (setf hour-local (if (zerop hour) 12 hour) am-pm "AM"))) - (format nil "~2,'0D:~2,'0D:~2,'0D ~A" - hour-local min sec am-pm)))) - (#\R . ,(time-lambda (hour min) (format nil "~2,'0D:~2,'0D" hour min))) - (#\s . ,(time-lambda ( sec min hour dom mon year) - (format nil "~D" - (- (encode-universal-time - sec min hour dom mon year) - (encode-universal-time 0 0 0 1 1 1970 0))))) - (#\S . ,(time-lambda (sec) (format nil "~2,'0D" sec))) - (#\t . ,(time-lambda () "~T")) - (#\T . ,(time-lambda (hour min sec) - (format nil "~2,'0D:~2,'0D:~2,'0D" hour min sec))) - (#\u . ,(time-lambda (dow) (format nil "~D" (+ dow 1)))) - ;; %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-lambda (dow) (format nil "~D" (- dow 1)))) - ;; %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-lambda (year) (subseq (format nil "~D" year) 2 4))) - (#\Y . ,(time-lambda (year) (format nil "~D" year))) - (#\z . ,(time-lambda (tz dstp) - (multiple-value-bind (hour-local decimal-local) - (truncate (+ (* (float tz) -1) (if dstp 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)))))) - ;; %: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) - ) - "An alist for the substitution in `format-time-string'.") - -(defvar *format-time-string-default* "%a %b %e %k:%M:%S %Y" - "The default value for `format-time-string', (e.g, Thu Mar 3 23:05:25 2005).") - -(defun format-time-string (&optional format-string time) - "Return a formatted date-time string of TIME or `get-decoded-time'. - -FORMAT-STRING defaults to `*format-time-string-default*' and accepts -the 'date' command options except the following ones: %g, %G, %j, %N, -%U, %V, %W, %x, %X, %:z, %::z, %:::z and %Z." - (let* ((time-string (or format-string - *format-time-string-default*))) - (when (> 2 (length time-string)) - (error "FORMAT-STRING should contains at least two characters.")) - (multiple-value-bind (sec min hour dom mon year dow dstp tz) - (or time (get-decoded-time)) - (loop - for format-position = (position #\% time-string :start (or format-position 0)) - while format-position do - (let* ((format-character (aref time-string (+ format-position 1))) - (action (or (cdr (assoc format-character - *format-time-string-alist*)) - (error "Invalid format option %~C" - format-character)))) - (setf time-string (concatenate 'string - (subseq time-string 0 format-position) - (funcall action sec min hour dom mon year dow dstp tz) - (subseq time-string (+ format-position 2)))) - (when (char-equal #\% format-character) ; escape character - (incf format-position))))) - (format nil time-string))) - -(defcommand echo-date () () - "Display the date and time." - (message "~a" (format-time-string))) - -(defcommand-alias time echo-date) - (defun programs-in-path (&optional full-path (path (split-string (getenv "PATH") ":"))) "Return a list of programs in the path that start with @var{base}. if @var{full-path} is @var{t} then return the full path, otherwise just diff --git a/version.lisp.in b/version.lisp.in index e0c120b..7333082 100644 --- a/version.lisp.in +++ b/version.lisp.in @@ -27,7 +27,10 @@ (export '(*version*)) -(defparameter *version* #.(concatenate 'string "@PACKAGE_VERSION@ Compiled On " (format-time-string))) +(defparameter *version* + #.(concatenate 'string "@PACKAGE_VERSION@ Compiled On " + (format-expand *time-format-string-alist* + *time-format-string-default*))) (defun echo-version (screen) (echo-string screen *version*)) -- 1.6.0.2