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 detail.
;;
;; 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/2010/mopa2e2.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:

(setq d-emacs-start-time (current-time))

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

;; (d-seconds-of-time-difference (current-time) d-emacs-start-time)
(defun d-seconds-of-time-difference (old-time new-time)
  "Returns the number of seconds that separate two time-measurments,
as returned by the function `current-time'."
  (d-assert (timep old-time))
  (d-assert (timep new-time))
  (let ((super-old (+ (* 65536.0 (car old-time)) (cadr old-time)))
        (super-new (+ (* 65536.0 (car new-time)) (cadr new-time))))
    (- 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")
;;; (d-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 "))))))

;; (d-seconds-to-readable-string 123 t nil)
;; (d-seconds-to-readable-string 123 nil t)
(defun d-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)))

;; (d-time--decode-time-readable (d-time--encode-time-readable (setq time "20180411-102818")))
(defun d-time--encode-time-readable (time)
  (interactive)
  (let* ((year   (d-read-str (substring time 0 4)))
         (month  (d-read-str (substring time 4 6)))
         (day    (d-read-str (substring time 6 8)))
         (hour   (d-read-str (substring time 9 11)))
         (minute (d-read-str (substring time 11 13)))
         (second (d-read-str (substring time 13 15)))
         (encoded (encode-time second minute hour day month year)))
    encoded))

(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)
                                      )))))

;; (setq time d-emacs-start-time)
(defun d-time--print-full-date-as-YYYYmmdd-HHMMSS (time &optional no-dow)
  (let (time1 dow year month day hour minute second)
    (setq time1   (decode-time (or time (current-time))))
    (setq dow     (aref ["SUN" "MON" "TUE" "WED" "THU" "FRI" "SAT"] (nth 6 time1)))
    (setq year    (nth 5 time1))
    (setq month   (nth 4 time1))
    (setq day     (nth 3 time1))
    (setq hour    (nth 2 time1))
    (setq minute  (nth 1 time1))
    (setq second  (nth 0 time1))
    (format "%04d-%02d-%02d %s %02d-%02d-%02d"
            year
            month
            day
            (if no-dow "" dow) ;; SUN MON TUE...
            hour
            minute
            second
            )))
;; end defun: d-time--print-full-date-as-YYYYmmdd-HHMMSS (time)

;; (setq hours -24)
(defun d-time--add-hours (t1 hours)
  (progn
    (setq t1 (current-time))
    (setq t1 (decode-time t1))
    (setq slot-seconds 0)
    (setq slot-minutes 1)
    (setq slot-hours 2)
    (setq slot-days 3)
    (setq slot-months 4)
    (setq slot-years 5)
    (incf (nth slot-hours t1) hours)
    (setq t1 (apply 'encode-time t1))
    (setq t1 (d-time--decode-time-readable t1)))
  )

(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)))

;; (setq YYYYmdd (decode-time (current-time))
(defun d-time--YYYYmmdd-HHMMSS-to-time (YYYYmmdd-HHMMSS)
  (let (years months days hours minutes seconds)
    (progn
      (d-assert (= (length "YYYYMMDD-HHMMSS") (length YYYYmmdd-HHMMSS)))
      ;;(debug "Paul Simon / The Rhythm Of The Saints / The Cool, Cool River")
      (setq years   (d-read-str (substring YYYYmmdd-HHMMSS 0 (length "YYYY"))))
      (setq months  (d-read-str (substring YYYYmmdd-HHMMSS (length "YYYY") (length "YYYYMM"))))
      (setq days    (d-read-str (substring YYYYmmdd-HHMMSS (length "YYYYMM") (length "YYYYMMDD"))))
      (setq hours   (d-read-str (substring YYYYmmdd-HHMMSS (length "YYYYMMDD-") (length "YYYYMMDD-HH"))))
      (setq minutes (d-read-str (substring YYYYmmdd-HHMMSS (length "YYYYMMDD-HH") (length "YYYYMMDD-HHMM"))))
      (setq seconds (d-read-str (substring YYYYmmdd-HHMMSS (length "YYYYMMDD-HHMM") (length "YYYYMMDD-HHMMSS"))))
      (encode-time seconds minutes hours days months years)
      )))

;; (setq YYYYmdd (decode-time (current-time))
(defun d-time--YYYYmmdd-to-time (YYYYmmdd)
  (let (years months days)
    (progn
      (assert (= (length "YYYYMMDD") (length YYYYmmdd)))
      (setq years   (d-read-str (substring YYYYmmdd 0 (length "YYYY"))))
      (setq months  (d-read-str (substring YYYYmmdd (length "YYYY") (length "YYYYmm"))))
      (setq days    (d-read-str (substring YYYYmmdd (length "YYYYmm") (length "YYYYmmdd"))))
      (encode-time 0 0 0 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 (d-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)) ))))

(progn
  (setq slot-seconds 0)
  (setq slot-minutes 1)
  (setq slot-hours   2)
  (setq slot-days    3)
  (setq slot-months  4)
  (setq slot-years   5))

(defun timep (time)
  (and (consp time)
       (integerp (car time))
       (integerp (cadr time))
       (> (car time) 0)
       (> (cadr time) 0)))

;; (setq time (current-time))
;; (setq secs-to-add 60)
(defun d-add-seconds (secs-to-add &optional time)
  (setq time (decode-time time))
  (let ((secs (nth slot-seconds time))
        (minutes (nth slot-minutes time))
        (hours   (nth slot-hours time))
        (days    (nth slot-days time))
        (months  (nth slot-months time))
        (years   (nth slot-years time)))
        (incf secs secs-to-add)
        (encode-time secs minutes hours days months years))
  )

(provide 'd-time)