Use and display New Earth Time in Emacs

new-earth-time.el

;;; new-earth-time.el --- "New Earth" date and time functions

;; Copyright (C) 2011  Robert Medeiros

;; Author: Robert Medeiros <[email protected]>
;; Keywords: calendar

;; This file 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.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; Miscellaneous date and time functions for the "New Earth Time"
;; international time system: http://newearthtime.net/

;;; Code:

;; Constants
;; -------------------------------------------------------------------

(defconst new-earth-time-url "http://newearthtime.net/")

(defconst seconds-per-minute 60
  "There are 60 seconds in a minute.")
(defconst seconds-per-hour 3600
  "There are 3600 seconds in an hour.")
(defconst seconds-per-day 86400
  "There are 86400 seconds in a day.")

(defconst seconds-per-net-degree 240
  "There are 240 seconds (4 minutes) in a single \"net degree\".")
(defconst seconds-per-net-minute 4
  "There a 4 seconds in a single \"net-minute\".")
(defconst seconds-per-net-second 0.06666667
  "A \"net second\" is 1/15th of standard second.")

;; Variables
;; -------------------------------------------------------------------


;; Functions
;; -------------------------------------------------------------------

(defun iso-date (&optional time)
  "Return an ISO-formatted date string for the given time. The
format of the time argument is the same as for the
format-time-string function."
  (interactive)
  (format-time-string "%Y-%m-%d" time))

(defun insert-iso-date (&optional time)
  "Insert the current date in ISO format."
  (interactive)
  (insert (iso-date time)))

(defun iso-date-time (&optional time)
  "Return an ISO-formatted date/time string for the given
time. The format of the time argument is the same as for the
format-time-string function."
  (interactive)
  (let ((date-string (iso-date time))
		(time-string (format-time-string "T%T%z")))
	(concat date-string time-string)))

(defun insert-iso-date-time (&optional time)
  "Insert the current date and time in ISO format. The format of
the time argument is the same as for the format-time-string
function."
  (interactive)
  (insert (iso-date-time time)))

(defun elapsed-seconds (hours minutes seconds)
  "Return the number of seconds elapsed at the given time in a
day, where HOURS is specified in 24-hour format."
   (+ (* hours seconds-per-hour)
	  (* minutes seconds-per-minute)
	  seconds))

(defun convert-new-earth-time (24hours minutes seconds &optional
									   timezone no-net-seconds no-net-minutes)
  "Convert the given time coordinates to a New Earth Time. If the
optional timezone is not specified, then the given time is
assumed to be UTC. The timezone value should be the number of
seconds of offset from UTC for the desired timezone. See the
current-time-zone function."
  (interactive)
  (let* ((zone-offset (if timezone timezone 0))
		 ; Seconds elapsed so far today; since new earth time is
		 ; calculated at the prime meridian, adjust by the number of
		 ; seconds this time zone is from UTC.
		 (seconds-today (elapsed-seconds 24hours minutes seconds))
		 (seconds-adjusted (% (- seconds-today zone-offset) seconds-per-day))
		 ; The number of NET degrees elapsed already today.
		 (net-degrees (floor (/ seconds-adjusted seconds-per-net-degree)))
		 ; The number of seconds left after dividing out NET degrees.
		 (seconds-for-minutes (% seconds-adjusted seconds-per-net-degree))
		 (net-minutes (floor (/ seconds-for-minutes seconds-per-net-minute)))
		 ; The number of seconds left after dividing out NET minutes.
		 (seconds-for-seconds (% seconds-for-minutes seconds-per-net-minute))
		 (net-seconds (floor (/ seconds-for-seconds seconds-per-net-second)))
		 (net-format (cond (no-net-minutes "%02d°")
						   (no-net-seconds "%02d°%02dʹ")
						   (t "%02d°%02dʹ%02dʺ"))))
	(format net-format net-degrees net-minutes net-seconds)))

(defun new-earth-time (&optional date suffix time)
  "Return a string representing the New Earth Time."
  (interactive)
  (let* ((unpacked-time (decode-time time))
		 (hour (caddr unpacked-time))
		 (minute (cadr unpacked-time))
		 (second (car unpacked-time))
		 (timezone (car (current-time-zone)))
		 (time-string (convert-new-earth-time hour minute second timezone))
		 (suffix-string (if suffix " NET" nil))
		 (date-string (if date (concat (iso-date time) " ") nil)))
	(concat date-string time-string suffix-string)))

(defun insert-new-earth-time (prefix)
  "Insert the current new earth time into the buffer. With a
single prefix argument, prepend the date to the new earth time
string. With two prefix arguments, also append the NET suffix."
  (interactive "p")
  (message (format "%d" prefix))
  (let ((date (>= prefix 4))
		(suffix (>= prefix 16)))
	(insert (new-earth-time date suffix))))

(defun insert-new-earth-time-anchor ()
  "Insert an HTML anchor containing the current new earth time,
that links to the website for the New Earth Time calendar system."
  (interactive)
  (insert (concat "<a href=\""
				  new-earth-time-url
				  "\">"
				  (new-earth-time t t)
				  "</a>")))

;; Display Time
;; -------------------------------------------------------------------

; Note that "net degrees" are 4 minutes long, "net minutes" are 4
; minutes/60 = 4 seconds long, and "net seconds" are 4 seconds/60 =
; 1/15 second long. A reasonable interval for updating the time
; display is therefore every four seconds.

(setq display-time-interval 4)

; TO DO: Update mouse actions? See EmacsWiki:InternetTime. Add load
; value?
(setq display-time-string-forms
	  '((if (and (not display-time-format) display-time-day-and-date)
			(concat year "-" month "-"
					(number-to-string (string-to-number day))
					" "))
		(propertize
		 (convert-new-earth-time (string-to-number 24-hours)
								 (string-to-number minutes)
								 (string-to-number seconds)
								 (car (current-time-zone))
								 t)
		 'help-echo (iso-date))
		(if mail
			(concat
			 " "
			 (propertize
			  display-time-mail-string
			  'display `(when (and display-time-use-mail-icon
								   (display-graphic-p))
						  ,@display-time-mail-icon
						  ,@(if (and display-time-mail-face
									 (memq (plist-get (cdr display-time-mail-icon)
													  :type)
										   '(pbm xbm)))
								(let ((bg (face-attribute display-time-mail-face
														  :background)))
								  (if (stringp bg)
									  (list :background bg)))))
			  'face display-time-mail-face
			  'help-echo "You have new mail; mouse-2: Read mail"
			  'mouse-face 'mode-line-highlight
			  'local-map (make-mode-line-mouse-map 'mouse-2
												   read-mail-command)))
		  "")))

;; Unit Tests
;; -------------------------------------------------------------------

(require 'behave)

(context "Hourly times throughout the day at UTC"
		 (tag convert-utc)

		 (specify "should map to 00°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 0 0 0) equal "00°00ʹ00ʺ"))

		 (specify "should map to 15°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 1 0 0) equal "15°00ʹ00ʺ"))

		 (specify "should map to 30°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 2 0 0) equal "30°00ʹ00ʺ"))

		 (specify "should map to 45°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 3 0 0) equal "45°00ʹ00ʺ"))

		 (specify "should map to 60°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 4 0 0) equal "60°00ʹ00ʺ"))

		 (specify "should map to 75°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 5 0 0) equal "75°00ʹ00ʺ"))

		 (specify "should map to 90°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 6 0 0) equal "90°00ʹ00ʺ"))

		 (specify "should map to 105°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 7 0 0) equal "105°00ʹ00ʺ"))

		 (specify "should map to 120°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 8 0 0) equal "120°00ʹ00ʺ"))

		 (specify "should map to 135°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 9 0 0) equal "135°00ʹ00ʺ"))

		 (specify "should map to 150°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 10 0 0) equal "150°00ʹ00ʺ"))

		 (specify "should map to 165°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 11 0 0) equal "165°00ʹ00ʺ"))

		 (specify "should map to 180°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 12 0 0) equal "180°00ʹ00ʺ"))

		 (specify "should map to 195°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 13 0 0) equal "195°00ʹ00ʺ"))

		 (specify "should map to 210°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 14 0 0) equal "210°00ʹ00ʺ"))

		 (specify "should map to 225°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 15 0 0) equal "225°00ʹ00ʺ"))

		 (specify "should map to 240°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 16 0 0) equal "240°00ʹ00ʺ"))

		 (specify "should map to 255°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 17 0 0) equal "255°00ʹ00ʺ"))

		 (specify "should map to 270°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 18 0 0) equal "270°00ʹ00ʺ"))

		 (specify "should map to 285°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 19 0 0) equal "285°00ʹ00ʺ"))

		 (specify "should map to 300°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 20 0 0) equal "300°00ʹ00ʺ"))

		 (specify "should map to 315°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 21 0 0) equal "315°00ʹ00ʺ"))

		 (specify "should map to 330°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 22 0 0) equal "330°00ʹ00ʺ"))

		 (specify "should map to 345°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 23 0 0) equal "345°00ʹ00ʺ"))

		 (specify "should map to 00°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 24 0 0) equal "00°00ʹ00ʺ")))

(context "Hourly times throughout the day at EST (-0500)"
		 (tag convert-local)
		 (lexical-let ((tz-offset -18000))

		 (specify "should map to 75°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 0 0 0 tz-offset) equal "75°00ʹ00ʺ"))

		 (specify "should map to 90°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 1 0 0 tz-offset) equal "90°00ʹ00ʺ"))

		 (specify "should map to 105°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 2 0 0 tz-offset) equal "105°00ʹ00ʺ"))

		 (specify "should map to 120°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 3 0 0 tz-offset) equal "120°00ʹ00ʺ"))

		 (specify "should map to 135°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 4 0 0 tz-offset) equal "135°00ʹ00ʺ"))

		 (specify "should map to 150°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 5 0 0 tz-offset) equal "150°00ʹ00ʺ"))

		 (specify "should map to 165°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 6 0 0 tz-offset) equal "165°00ʹ00ʺ"))

		 (specify "should map to 180°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 7 0 0 tz-offset) equal "180°00ʹ00ʺ"))

		 (specify "should map to 195°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 8 0 0 tz-offset) equal "195°00ʹ00ʺ"))

		 (specify "should map to 210°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 9 0 0 tz-offset) equal "210°00ʹ00ʺ"))

		 (specify "should map to 225°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 10 0 0 tz-offset) equal "225°00ʹ00ʺ"))

		 (specify "should map to 240°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 11 0 0 tz-offset) equal "240°00ʹ00ʺ"))

		 (specify "should map to 255°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 12 0 0 tz-offset) equal "255°00ʹ00ʺ"))

		 (specify "should map to 270°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 13 0 0 tz-offset) equal "270°00ʹ00ʺ"))

		 (specify "should map to 285°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 14 0 0 tz-offset) equal "285°00ʹ00ʺ"))

		 (specify "should map to 300°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 15 0 0 tz-offset) equal "300°00ʹ00ʺ"))

		 (specify "should map to 315°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 16 0 0 tz-offset) equal "315°00ʹ00ʺ"))

		 (specify "should map to 330°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 17 0 0 tz-offset) equal "330°00ʹ00ʺ"))

		 (specify "should map to 345°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 18 0 0 tz-offset) equal "345°00ʹ00ʺ"))

		 (specify "should map to 00°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 19 0 0 tz-offset) equal "00°00ʹ00ʺ"))

		 (specify "should map to 15°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 20 0 0 tz-offset) equal "15°00ʹ00ʺ"))

		 (specify "should map to 30°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 21 0 0 tz-offset) equal "30°00ʹ00ʺ"))

		 (specify "should map to 45°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 22 0 0 tz-offset) equal "45°00ʹ00ʺ"))

		 (specify "should map to 60°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 23 0 0 tz-offset) equal "60°00ʹ00ʺ"))

		 (specify "should map to 75°00ʹ00ʺ NET"
				  (expect (convert-new-earth-time 24 0 0 tz-offset) equal "75°00ʹ00ʺ"))))

(provide 'new-earth-time)
;;; new-earth-time.el ends here