[Emacs-orgmode] Suggested change to round timestamps.

[Alex Bochannek]

When I first started using Org-mode to keep track of events during the
day, I found the timestamp function extremely handy. I didn't want to
keep time to the minute, but round to, e.g., fifteen minute intervals.

Attached is the patch that I am proposing. Since it was originally
against 4.01, I hope I didn't miss anything important.

Alex.

*** org.el      13 Mar 2006 15:08:15 -0800      1.8
--- org.el      13 Mar 2006 15:26:19 -0800      
***************
*** 433,438 ****
--- 433,444 ----
  It is not recommended to change this constant.")
  
  
+ (defcustom org-time-stamp-rounding-minutes 0
+   "No. of minutes to round time stamps to upon insertion.
+ When zero, insert the time unmodified."
+   :group 'org-time
+   :type 'integer)
+ 
  (defcustom org-deadline-warning-days 30
    "No. of days before expiration during which a deadline becomes active.
  This variable governs the display in the org file."
***************
*** 3396,3402 ****
          (looking-at org-todo-line-regexp)
          (goto-char (or (match-end 2) (match-beginning 3)))
          (insert "(" (format-time-string (cdr org-time-stamp-formats)
!                                         (current-time))
                  ")"))
        ;; Save the buffer, if it is not the same buffer.
        (if (not (eq this-buffer buffer)) (save-buffer))))
--- 3402,3409 ----
          (looking-at org-todo-line-regexp)
          (goto-char (or (match-end 2) (match-beginning 3)))
          (insert "(" (format-time-string (cdr org-time-stamp-formats)
!                                         (org-time-stamp-round
!                                          (current-time)))
                  ")"))
        ;; Save the buffer, if it is not the same buffer.
        (if (not (eq this-buffer buffer)) (save-buffer))))
***************
*** 3627,3633 ****
        (insert org-closed-string " "
                (format-time-string
                 (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
!                (current-time))
                "\n")))))
  
  (defun org-show-todo-tree (arg)
--- 3634,3641 ----
        (insert org-closed-string " "
                (format-time-string
                 (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
!                (org-time-stamp-round
!                 (current-time)))
                "\n")))))
  
  (defun org-show-todo-tree (arg)
***************
*** 3993,4008 ****
      (org-detatch-overlay org-date-ovl)
  
      (if (string-match
!        "^ 
*\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
        (progn
!         (setq year (if (match-end 2)
!                        (string-to-number (match-string 2 ans))
                       (string-to-number (format-time-string "%Y")))
!               month (string-to-number (match-string 3 ans))
!               day (string-to-number (match-string 4 ans)))
          (if (< year 100) (setq year (+ 2000 year)))
          (setq ans (replace-match (format "%04d-%02d-%02d" year month day)
!                                  t t ans))))
      (setq tl (parse-time-string ans)
          year (or (nth 5 tl) (string-to-number (format-time-string "%Y")))
          month (or (nth 4 tl) (string-to-number (format-time-string "%m")))
--- 4001,4016 ----
      (org-detatch-overlay org-date-ovl)
  
      (if (string-match
!        "^ 
*\\(\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\)\\([^-0-9]\\|$\\)"
 ans)
        (progn
!         (setq year (if (match-end 3)
!                        (string-to-number (match-string 3 ans))
                       (string-to-number (format-time-string "%Y")))
!               month (string-to-number (match-string 4 ans))
!               day (string-to-number (match-string 5 ans)))
          (if (< year 100) (setq year (+ 2000 year)))
          (setq ans (replace-match (format "%04d-%02d-%02d" year month day)
!                                  t t ans 1))))
      (setq tl (parse-time-string ans)
          year (or (nth 5 tl) (string-to-number (format-time-string "%Y")))
          month (or (nth 4 tl) (string-to-number (format-time-string "%m")))
***************
*** 4014,4019 ****
--- 4022,4038 ----
             (nth 2 tl))
        (setq org-time-was-given t))
      (if (< year 100) (setq year (+ 2000 year)))
+     (if (or org-time-was-given with-time)
+       (progn
+         (setq tl (decode-time
+                   (org-time-stamp-round
+                    (encode-time second minute hour day month year))))
+         (setq  year (nth 5 tl)
+                month (nth 4 tl)
+                day (nth 3 tl)
+                hour (nth 2 tl)
+                minute (nth 1 tl)
+                second (nth 0 tl))))
      (if to-time
        (encode-time second minute hour day month year)
        (if (or (nth 1 tl) (nth 2 tl))
***************
*** 4174,4179 ****
--- 4193,4218 ----
            nil nil nil)
      (make-list 9 0)))
  
+ (defun org-time-stamp-round (arg)
+   "Round a time to the closest `org-time-stamp-rounding-minutes'
+ interval."
+   (when (and
+        (/= 0 org-time-stamp-rounding-minutes)
+        (wholenump org-time-stamp-rounding-minutes))
+       (let* (time rounding diff lower upper)
+       (setq time (float-time arg))
+       (setq rounding (* org-time-stamp-rounding-minutes 60))
+       (setq delta (mod time rounding))
+       (setq lower (* (float (floor time rounding)) rounding))
+       (setq upper (* (float (ceiling time rounding)) rounding))
+       (if (/= 0 delta)
+         (if (< (- delta (/ rounding 2.0)) 0)
+             (list (truncate lower 65536.0)
+                   (truncate (mod lower 65536.0)))
+           (list (truncate upper 65536.0)
+                 (truncate (mod upper 65536.0))))
+         arg))))
+   
  (defun org-timestamp-up (&optional arg)
    "Increase the date item at the cursor by one.
  If the cursor is on the year, change the year.  If it is on the month or
***************
*** 7857,7863 ****
                                         -1) ?\ ))
          ;; We need to add a headline:  Use time and first buffer line
          (setq lines (cons first lines)
!               first (concat "* " (current-time-string)
                              " (" (remember-buffer-desc) ")")
                indent "  "))
        (if org-adapt-indentation
--- 7896,7905 ----
                                         -1) ?\ ))
          ;; We need to add a headline:  Use time and first buffer line
          (setq lines (cons first lines)
!               first (concat "* " (format-time-string
!                                   (cdr org-time-stamp-formats)
!                                   (org-time-stamp-round
!                                    (current-time)))
                              " (" (remember-buffer-desc) ")")
                indent "  "))
        (if org-adapt-indentation
***************
*** 10672,10679 ****
                           ".txt"))
         (buffer (find-file-noselect filename))
         (levels-open (make-vector org-level-max nil))
!        (date  (format-time-string "%Y/%m/%d" (current-time)))
!        (time  (format-time-string "%X" (current-time)))
         (author      user-full-name)
         (title       (buffer-name))
         (options     nil)
--- 10714,10723 ----
                           ".txt"))
         (buffer (find-file-noselect filename))
         (levels-open (make-vector org-level-max nil))
!        (date  (format-time-string "%Y/%m/%d" (org-time-stamp-round
!                                               (current-time))))
!        (time  (format-time-string "%X" (org-time-stamp-round
!                                         (current-time))))
         (author      user-full-name)
         (title       (buffer-name))
         (options     nil)
***************
*** 11012,11019 ****
                             ".html"))
           (buffer (find-file-noselect filename))
           (levels-open (make-vector org-level-max nil))
!        (date (format-time-string "%Y/%m/%d" (current-time)))
!        (time  (format-time-string "%X" (current-time)))
           (author      user-full-name)
         (title       (buffer-name))
           (options     nil)
--- 11056,11065 ----
                             ".html"))
           (buffer (find-file-noselect filename))
           (levels-open (make-vector org-level-max nil))
!        (date (format-time-string "%Y/%m/%d" (org-time-stamp-round
!                                              (current-time))))
!        (time  (format-time-string "%X" (org-time-stamp-round
!                                         (current-time))))
           (author      user-full-name)
         (title       (buffer-name))
           (options     nil)
***************
*** 11806,11812 ****
  When COMBINE is non nil, add the category to each line."
    (let ((re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
        (dts (org-ical-ts-to-string
!             (format-time-string (cdr org-time-stamp-formats) (current-time))
              "DTSTART"))
        hd ts ts2 state (inc t) pos scheduledp deadlinep tmp pri)
      (save-excursion
--- 11852,11860 ----
  When COMBINE is non nil, add the category to each line."
    (let ((re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
        (dts (org-ical-ts-to-string
!             (format-time-string (cdr org-time-stamp-formats)
!                                 (org-time-stamp-round
!                                  (current-time)))
              "DTSTART"))
        hd ts ts2 state (inc t) pos scheduledp deadlinep tmp pri)
      (save-excursion