d-time.el

    

;;; d-time.el --- A collection of useful time functions

;; Copyright (C) 2006-2014 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Keywords: timer functions
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This code provides some useful time functions.

;;; Limitation of Warranty

;; This program 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 3 of the License, or (at
;; your option) any later version.
;;
;; This program 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, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2006/mopa2e.html#d-time>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'd-time)

;;; Known Bugs:

;; none!

;;; Code:

(if emacs-dialect--xemacs-p
    (setq display-time-compatible t))

(defun seconds-of-time-difference (old new)
  "Returns the number of seconds that separate two time-measurments,
as returned by the function `current-time'."
  (let ((super-old (+ (* 65536.0 (car old)) (cadr old)))
        (super-new (+ (* 65536.0 (car new)) (cadr new))))
    (- super-new super-old)))

;;; (setq yyyymmdd-hhmmss "20131202-191239")
;;;
;;; (encode-time 0 minute hour day month year)
;;;
;;; (decode-time (current-time))
;;;
;;;
;;; (setq new "20131202-191317")


;;;
;;;
;;;   (seconds-of-time-difference encoded-time (current-time))
;;;
;;;

;; (setq value 123)
;; (setq units "minute")
;; (say-number-in-words value units t)
;; (say-number-in-words value units)
(defun say-number-in-words (value units &optional short)
  (if short
      (if (/= 0 value)
          (concat
           (int-to-string value)
           (concat (substring units 0 1))))
    (if (/= 0 value)
        (concat
         (int-to-string value)
         (if (= 1 value)
             (concat " " units " ")
           (concat " " units "s "))))))

;; (seconds-to-readable-string 123 nil nil)
;; (seconds-to-readable-string 123 nil t)
(defun seconds-to-readable-string (time-in-secs &optional no-seconds short)
  "Converts TIME-IN-SECS to a readable value of years, weeks,
days, hours, minutes, seconds.  Called with x nil nil this
function is the inverse of `timer-duration'. Assumes there are 60
seconds in 1 minute, 60 minutes in 1 hour, 24 hours in 1 day, 7
days in 1 week, 4 weeks in 1 month (this is an approximation) and
12 months in 1 year.  Note: months are not returned because
months (m) conflict with minutes (also m)."
  (let* ((secs-per-hour (* 60 60))
         (secs-per-day   (* 24 secs-per-hour))
         (secs-per-week  (* 7 secs-per-day))
         ;;(secs-per-month (* 4 secs-per-week))
         (secs-per-year  (* 365.25 secs-per-day))

(years        (floor (/ time-in-secs secs-per-year)))

(time-in-secs (- time-in-secs (* secs-per-year years)))

         ;;(months       (floor (/ time-in-secs secs-per-month)))
         ;;(time-in-secs (- time-in-secs (* secs-per-month months)))

         (weeks        (floor (/ time-in-secs secs-per-week)))
         (time-in-secs (- time-in-secs (* secs-per-week weeks)))

(days         (floor (/ time-in-secs secs-per-day)))
         (time-in-secs (- time-in-secs (* secs-per-day days)))

(hours        (floor (/ time-in-secs secs-per-hour)))
         (time-in-secs (- time-in-secs (* secs-per-hour hours)))

(minutes      (floor (/ time-in-secs 60)))
         (time-in-secs (- time-in-secs (* 60 minutes)))

(seconds      (round time-in-secs))

         ;; (setq years 12)
         (string (concat (say-number-in-words years   "year" short)
                         ;;(say-number-in-words months  "month" short)
                         (say-number-in-words weeks   "week" short)
                         (say-number-in-words days    "day" short)
                         (say-number-in-words hours   "hour" short)
                         (say-number-in-words minutes "minute" short)
                         (if (not no-seconds)
                             (say-number-in-words seconds "second" short)))))
    (if (string= "" string)
        "zero time!"
      (if short string (substring string 0 -1)))))


;;;
;;; DISPLAY THE TIME ON MODELINE:
(d-quote condition-case err
    (progn
      (setq display-time-string-forms
            '(year
              "-"
              (format "%02d" (read month))
              "-"
              (format "%02d" (read day))
              " "
              dayname " "
              24-hours ":" minutes))
      (setq display-time-string-forms nil)
;;      (setq display-time-day-and-date t)
;;      (setq display-time-24hr-format t)
      (display-time))
  (error
   (message "Cannot display time %s" (cdr err))))

(require 'timer)

;;; (d-time--get-stamp d-emacs-start-time)
;;; (d-time--get-stamp)
(defun d-time--get-stamp (&optional time)
  (interactive "Senter time string: ")
  (let ((time-list (decode-time time)))
    (setq yyyymmdd (format "%04d%02d%02d" (nth 5 time-list) (nth 4 time-list) (nth 3 time-list)))
    (setq hhmmss   (format "%02d%02d%02d" (nth 2 time-list) (nth 1 time-list) (nth 0 time-list)))
    (setq dt-stamp (concat yyyymmdd "-" hhmmss))
    ;;(message "Time stamp=%s" dt-stamp)
    dt-stamp
    ))

;;;
;;; (insert (d-time--decode-time-readable d-emacs-start-time))
;;; (insert (d-time--decode-time-readable (current-time)))
;;;
(defun d-time--decode-time-readable (&optional time)
  (interactive)
  (let* ((decoded  (decode-time time))
         (year     (nth 5 decoded))
         (month    (nth 4 decoded))
         (day      (nth 3 decoded))
         (hour     (nth 2 decoded))
         (minute   (nth 1 decoded))
         (second   (nth 0 decoded))
         (yyyymmdd (format "%04d%02d%02d" year month day))
         (hhmmss   (format "%02d%02d%02d" hour minute second)))
    (concat yyyymmdd "-" hhmmss)))

(defun d-time--frame-title ()
  (let (time dow year month day hour minute second)
    (setq time (decode-time (current-time)))
    (setq dow     (aref ["SUN" "MON" "TUE" "WED" "THU" "FRI" "SAT"] (nth 6 time)))
    (setq year    (nth 5 time))
    (setq month   (nth 4 time))
    (setq day     (nth 3 time))
    (setq hour    (nth 2 time))
    (setq minute  (nth 1 time))
    (setq second  (nth 0 time))
    (setq frame-title-format (format "%02d:%02d:%02d %s %04d-%02d-%02d    %s"
                                     hour
                                     minute
                                     second
                                     dow
                                     year
                                     month
                                     day
                                     (cond
                                      ((buffer-file-name)
                                       (buffer-file-name))
                                      ((buffer-name)
                                       (buffer-name))
                                      (default-directory
                                        default-directory)
                                      )))))

(byte-compile 'd-time--frame-title)
;;(symbol-function 'd-time--frame-title)

(run-with-timer 1 1 'd-time--frame-title)

(defun d-time--current-line-as-string ()
  (buffer-substring-no-properties (point-at-bol)
                                  (point-at-eol)))

(defun d-time--yyyymmdd-hhmmss-to-time (yyyymmdd-hhmmss)
  (let (years months days hours minutes)
    (progn
      (assert (= (length "YYYYMMDD-HHMMSS") (length yyyymmdd-hhmmss)))
      (setq years   (read-str (substring yyyymmdd-hhmmss 0 (length "YYYY"))))
      (setq months  (read-str (substring yyyymmdd-hhmmss (length "YYYY") (length "YYYYMM"))))
      (setq days    (read-str (substring yyyymmdd-hhmmss (length "YYYYMM") (length "YYYYMMDD"))))
      (setq hours   (read-str (substring yyyymmdd-hhmmss (length "YYYYMMDD-") (length "YYYYMMDD-HH"))))
      (setq minutes (read-str (substring yyyymmdd-hhmmss (length "YYYYMMDD-HH") (length "YYYYMMDD-HHMM"))))
      (setq seconds (read-str (substring yyyymmdd-hhmmss (length "YYYYMMDD-HHMM") (length "YYYYMMDD-HHMMSS"))))
      (encode-time seconds minutes hours days months years)
      )))

(run-with-timer 1 1 'force-mode-line-update)

(defun load-file-most-recent (str)
  (interactive "FEnter filename: ")
  (let ((el-str  (concat str ".el"))
        (elc-str (concat str ".elc")))
    (setq el-time  (nth 5 (file-attributes el-str)))
    (setq elc-time (nth 5 (file-attributes elc-str)))
    (setq dif (seconds-of-time-difference el-time elc-time))
    (if (<= dif 0)
        (progn
          (message "Loading file...%s" el-str)
          (load-file el-str))
      (message "Loading file...%s" elc-str)
      (load-file elc-str)
      )))

;; (progn (setq year1 1995) (setq month1 1) (setq day1 1))
;; (progn (setq year2 2015) (setq month2 12) (setq day2 31))
(defun time-between-times (year1 month1 day1
                           year2 month2 day2)
  (let*
      ((seconds-then  (float-time (encode-time 0 0 0 day1 month1 year1)))
       (seconds-now   (float-time (encode-time 0 0 0 day2 month2 year2)))
       (seconds-diff  (- seconds-now seconds-then)) )
    (format-seconds "%Y, %D" seconds-diff))
  )

(defun get-time-since (year month day)
  (interactive "nyear: \nnmonth: \nnday: ")
  (message "%s" (format-seconds
                 "%Y, %D"
                 (float-time
                  (time-since (encode-time 0 0 0 day month year)) ))))

(provide 'd-time)