[nongnu] elpa/org-journal a834a5325e 7/7: Merge branch 'fix-merge-420'

[ELPA Syncer]

branch: elpa/org-journal
commit a834a5325e4196538b6c7b67bf219a6ed2e8c02c
Merge: 7cf8922003 46146e71cb
Author: Christian Schwarzgruber <c.schwarzgruber.cs@gmail.com>
Commit: Christian Schwarzgruber <c.schwarzgruber.cs@gmail.com>

    Merge branch 'fix-merge-420'
    
    Fix #308, Fix #338
    Close #420, Close #422
---
 org-journal.el            |  90 ++++++++++++------
 tests/org-journal-test.el | 227 +++++++++++++++++++++++-----------------------
 2 files changed, 179 insertions(+), 138 deletions(-)

diff --git a/org-journal.el b/org-journal.el
index 8b51a36e5e..ca747ecbe7 100644
--- a/org-journal.el
+++ b/org-journal.el
@@ -394,6 +394,10 @@ This prefix key is used for:
 - `org-journal-search' (key \"s\")"
   :type 'string)
 
+(defcustom org-journal-scheduled-string ""      ; or org-scheduled-string
+  "String added before a time stamp for schedules."
+  :type 'string)
+
 (defvar org-journal-after-entry-create-hook nil
   "Hook called after journal entry creation.")
 
@@ -731,7 +735,7 @@ This allows the use of `org-journal-tag-alist' and
           (org-set-tags org-crypt-tag-matcher)))
       (run-hooks 'org-journal-after-header-create-hook))))
 
-(defun org-journal--insert-entry (time org-extend-today-until-active-p)
+(defun org-journal--insert-entry (time org-extend-today-until-active-p 
&optional no-timestamp)
   "Insert a new entry."
   (unless (eq (current-column) 0) (insert "\n"))
   (let* ((day-discrepancy (- (time-to-days (current-time)) (time-to-days 
time)))
@@ -747,11 +751,11 @@ This allows the use of `org-journal-tag-alist' and
                          (format-time-string org-journal-time-format)))
                       ;; “time” is on some other day, use blank timestamp
                       (t ""))))
-    (insert org-journal-time-prefix timestamp))
+    (insert org-journal-time-prefix (if no-timestamp "" timestamp)))
   (run-hooks 'org-journal-after-entry-create-hook))
 
 ;;;###autoload
-(defun org-journal-new-entry (prefix &optional time)
+(defun org-journal-new-entry (prefix &optional time no-timestamp)
   "Open today's journal file and start a new entry.
 
 With a PREFIX arg, open the today's file, create a heading if it
@@ -805,7 +809,7 @@ hook is run."
       (goto-char (point-max)))
 
     (when should-add-entry-p
-      (org-journal--insert-entry time org-extend-today-until-active-p))
+      (org-journal--insert-entry time org-extend-today-until-active-p 
no-timestamp))
 
     (if (and org-journal-hide-entries-p (org-journal--time-entry-level))
         (outline-hide-sublevels (org-journal--time-entry-level))
@@ -1103,46 +1107,78 @@ insert just the heading."
         (org-journal-new-entry prefix time)
       (org-journal-new-scheduled-entry prefix time))))
 
+
+(defvar org-time-was-given)
+(defvar org-end-time-was-given)
+
 ;;;###autoload
 (defun org-journal-new-scheduled-entry (prefix &optional scheduled-time)
   "Create a new entry in the future with an active timestamp.
 
 With non-nil prefix argument create a regular entry instead of a TODO entry."
   (interactive "P")
-  (let ((time (or scheduled-time (org-time-string-to-time (org-read-date nil 
nil nil "Date:"))))
-        org-journal-carryover-items)
+  (let* ((org-time-was-given nil) (org-end-time-was-given nil)
+         (time (or scheduled-time (org-time-string-to-time (org-read-date nil 
nil nil "Date:"))))
+         org-journal-carryover-items)
     (when (time-less-p time (current-time))
       (user-error "Scheduled time needs to be in the future"))
-    (org-journal-new-entry nil time)
+    (org-journal-new-entry nil time t)
     (unless prefix
       (insert "TODO "))
+    (if org-time-was-given
+        (insert (format-time-string org-journal-time-format time)))
     (save-excursion
-      (insert "\n")
-      (org-insert-time-stamp time t))))
+      (insert "\n"
+              org-journal-scheduled-string
+              (if (length> org-journal-scheduled-string 0) " " ""))
+      (org-insert-time-stamp
+       time org-time-was-given nil nil nil (list org-end-time-was-given)))))
 
 ;;;###autoload
 (defun org-journal-reschedule-scheduled-entry (&optional time)
   "Reschedule an entry in the future."
   (interactive "P")
-  (or time (setq time (org-time-string-to-time (org-read-date nil nil nil 
"Data:"))))
-  (when (time-less-p time (current-time))
-    (user-error "Scheduled time needs to be in the future"))
-  (save-excursion
-    (save-restriction
-      (org-back-to-heading)
-      (org-narrow-to-subtree)
-      (if (re-search-forward org-ts-regexp (line-end-position 2) t)
-          (replace-match "")
-        (org-end-of-subtree)
-        (insert "\n"))
-      (org-insert-time-stamp time)
-      (org-cut-subtree))
-    (let (org-journal-carryover-items)
-      (org-save-outline-visibility t
-        (org-journal-new-entry t time)
-        (when (looking-back "[^\t ]" (point-at-bol) t)
+  (let ((org-time-was-given nil) (org-end-time-was-given nil))
+    (or time (setq time (org-time-string-to-time (org-read-date nil nil nil 
"Date:"))))
+    (when (time-less-p time (current-time))
+      (user-error "Scheduled time needs to be in the future"))
+    (save-excursion
+      (save-restriction
+        (org-back-to-heading)
+        (org-narrow-to-subtree)
+        ;; update time after org-journal-time-prefix
+        (let ((regexp
+               (concat
+                "^"
+                (regexp-quote org-journal-time-prefix)
+                "\\(TODO \\)?"
+                "\\("
+                (replace-regexp-in-string "[[:digit:]]" "[[:digit:]]"
+                                          (format-time-string 
org-journal-time-format '(0 0) t))
+                "\\)")))
+          (if (re-search-forward regexp (line-end-position) t)
+              (progn
+                (delete-region (match-beginning 2) (match-end 2))
+                (if org-time-was-given
+                    (insert (format-time-string org-journal-time-format 
time))))))
+        ;; update time of timestamp (<...>)
+        (org-back-to-heading)
+        (if (re-search-forward (concat (regexp-quote 
org-journal-scheduled-string)
+                                       "[[:blank:]]*" org-ts-regexp)
+                               nil t)
+            (replace-match "")
+          (org-end-of-subtree)
           (insert "\n"))
-        (org-yank)))))
+        (insert org-journal-scheduled-string
+                (if (length> org-journal-scheduled-string 0) " " ""))
+        (org-insert-time-stamp time org-time-was-given nil nil nil (list 
org-end-time-was-given))
+        (org-cut-subtree))
+      (let (org-journal-carryover-items)
+        (org-save-outline-visibility t
+                                     (org-journal-new-entry t time)
+                                     (when (looking-back "[^\t ]" 
(point-at-bol) t)
+                                       (insert "\n"))
+                                     (org-yank))))))
 
 (defun org-journal--goto-entry (date)
   "Goto DATE entry in current journal file."
diff --git a/tests/org-journal-test.el b/tests/org-journal-test.el
index c43289d451..ff54f76ef3 100644
--- a/tests/org-journal-test.el
+++ b/tests/org-journal-test.el
@@ -107,58 +107,59 @@
 (ert-deftest org-journal-insert-header-test ()
   "Test insertion of header"
   (org-journal-test-macro
-      (let ((org-journal-file-header "#+TITLE: Some header\n#+STARTUP: 
folded"))
-        (let ((inhibit-message t))
-          (org-journal-new-entry t))
-        (save-buffer)
-        (kill-buffer)
-        (should (string= (with-temp-buffer
-                           (insert-file-contents (org-journal--get-entry-path))
-                           (buffer-substring-no-properties (point-min) 
(point-max)))
-                         (concat org-journal-file-header "\n* Test 
header\n"))))))
+   (let ((org-journal-file-header "#+TITLE: Some header\n#+STARTUP: folded"))
+     (let ((inhibit-message t))
+       (org-journal-new-entry t))
+     (save-buffer)
+     (kill-buffer)
+     (should (string= (with-temp-buffer
+                        (insert-file-contents (org-journal--get-entry-path))
+                        (buffer-substring-no-properties (point-min) 
(point-max)))
+                      (concat org-journal-file-header "\n* Test header\n"))))))
 
 (ert-deftest org-journal-carryover-items-test ()
   "Org journal new entry test."
   (org-journal-test-macro
-      (let ((org-journal-file-type 'weekly)
-            ;; Always use english as time locale.
-            (system-time-locale "C")
-            (buffer "20181231"))
-        (with-temp-buffer
-          (insert "* Tuesday, 01/01/19\n")
-          (org-set-property "CREATED" "20190101")
-          (insert "** 13:00 Some journal entry\n")
-          (insert "* Wednesday, 01/02/19\n")
-          (org-set-property "CREATED" "20190102")
-          (insert "** TODO First\n")
-          (insert "** 13:00 Some journal entry 1\n")
-          (insert "** TODO Second\n")
-          (insert "** 14:00 Some journal entry 2\n")
-          (write-file (expand-file-name buffer org-journal-dir-test))
-          (kill-buffer buffer))
-        (find-file (expand-file-name buffer org-journal-dir-test))
-        (should (not (stringp (org-journal-read-or-display-entry (encode-time 
0 0 0 1 1 2019)))))
-        (kill-buffer buffer)
-        (should (not (stringp (org-journal-read-or-display-entry (encode-time 
0 0 0 2 1 2019)))))
-        (kill-buffer buffer)
-        (org-journal-new-entry t)
-        (save-buffer)
-        (kill-buffer) ;; Kills new journal file buffer
-        (kill-buffer buffer)
-        (should (not (stringp (org-journal-read-or-display-entry (encode-time 
0 0 0 1 1 2019)))))
-        (kill-buffer)
-        (should (not (stringp (org-journal-read-or-display-entry (encode-time 
0 0 0 2 1 2019)))))
-        (kill-buffer)
+   (let ((org-journal-file-type 'weekly)
+         ;; Always use english as time locale.
+         (system-time-locale "C")
+         (buffer "20181231"))
+     (with-temp-buffer
+       (org-journal-mode)
+       (insert "* Tuesday, 01/01/19\n")
+       (org-set-property "CREATED" "20190101")
+       (insert "** 13:00 Some journal entry\n")
+       (insert "* Wednesday, 01/02/19\n")
+       (org-set-property "CREATED" "20190102")
+       (insert "** TODO First\n")
+       (insert "** 13:00 Some journal entry 1\n")
+       (insert "** TODO Second\n")
+       (insert "** 14:00 Some journal entry 2\n")
+       (write-file (expand-file-name buffer org-journal-dir-test))
+       (kill-buffer buffer))
+     (find-file (expand-file-name buffer org-journal-dir-test))
+     (should (not (stringp (org-journal-read-or-display-entry (encode-time 0 0 
0 1 1 2019)))))
+     (kill-buffer buffer)
+     (should (not (stringp (org-journal-read-or-display-entry (encode-time 0 0 
0 2 1 2019)))))
+     (kill-buffer buffer)
+     (org-journal-new-entry t)
+     (save-buffer)
+     (kill-buffer) ;; Kills new journal file buffer
+     (kill-buffer buffer)
+     (should (not (stringp (org-journal-read-or-display-entry (encode-time 0 0 
0 1 1 2019)))))
+     (kill-buffer)
+     (should (not (stringp (org-journal-read-or-display-entry (encode-time 0 0 
0 2 1 2019)))))
+     (kill-buffer)
 
-        (should (string= (with-temp-buffer
-                           (org-journal-mode)
-                           (insert-file-contents (org-journal--get-entry-path))
-                           (replace-regexp-in-string
-                            "^[ ]*" ""
-                            (buffer-substring-no-properties (point-min) 
(point-max))))
-                         (concat "* Test header\n:PROPERTIES:\n:CREATED:  "
-                                 (format-time-string 
org-journal-created-property-timestamp-format)
-                                 "\n:END:\n** TODO First\n** TODO 
Second\n"))))))
+     (should (string= (with-temp-buffer
+                        (org-journal-mode)
+                        (insert-file-contents (org-journal--get-entry-path))
+                        (replace-regexp-in-string
+                         "^[ ]*" ""
+                         (buffer-substring-no-properties (point-min) 
(point-max))))
+                      (concat "* Test header\n:PROPERTIES:\n:CREATED:  "
+                              (format-time-string 
org-journal-created-property-timestamp-format)
+                              "\n:END:\n** TODO First\n** TODO Second\n"))))))
 
 (ert-deftest org-journal-carryover-keep-parents-test ()
   "Org journal new entry test for daily files."
@@ -199,6 +200,7 @@
             (org-journal-carryover-delete-empty-journal 'always))
         ;; Test that journal file gets dumped, after carryover
         (with-temp-buffer
+          (org-journal-mode)
           (insert "* Wednesday, 01/02/19\n")
           (insert "** TODO a\n")
           (write-file (expand-file-name buffer org-journal-dir-test))
@@ -212,6 +214,7 @@
         (org-journal-dir-test-setup)
         (setq org-journal-file-type 'yearly)
         (with-temp-buffer
+          (org-journal-mode)
           (insert "* Wednesday, 01/01/19\n")
           (org-set-property "CREATED" "20190101")
           (insert "** TODO a\n")
@@ -223,10 +226,12 @@
         (org-journal-new-entry nil)
         (save-buffer)
         (kill-buffer)
-        (let ((inhibit-message t))
-          (should
-           (string= "No journal entry for this date."
-                    (org-journal-read-or-display-entry (encode-time 0 0 0 2 1 
2019) 'noselect)))))))
+        (let ((message-marker nil))
+          (cl-letf (((symbol-function 'message)
+                     #'(lambda (x &rest y) (setq message-marker x))))
+            (org-journal-read-or-display-entry (encode-time 0 0 0 2 1 2019) 
'noselect)
+            (should (equal "No journal entry for this date." message-marker))
+            )))))
 
 (ert-deftest org-journal-search-build-file-list-test ()
   "Test for `org-journal--search-build-file-list'."
@@ -318,66 +323,66 @@
 
 (ert-deftest org-journal-scheduled-weekly-test ()
   (org-journal-test-macro
-      (let ((org-journal-file-type 'weekly)
-            (org-journal-start-on-weekday 7) ;; sunday
-            org-journal-encrypt-journal
-            org-journal-enable-encryption
-            org-journal-enable-cache
-            org-journal-file-header
-            day-offset)
+   (let ((org-journal-file-type 'weekly)
+         (org-journal-start-on-weekday 7) ;; sunday
+         org-journal-encrypt-journal
+         org-journal-enable-encryption
+         org-journal-enable-cache
+         org-journal-file-header
+         day-offset)
 
-        ;; Compute correct day-offset, so future and today journal entry end 
in the same file
-        (let ((current-date (calendar-current-date))
-              (current-date+1 (calendar-current-date 1)))
-          (if (equal (org-journal--convert-time-to-file-type-time
-                      (org-journal--calendar-date->time current-date) )
-                     (org-journal--convert-time-to-file-type-time
-                      (org-journal--calendar-date->time current-date+1)))
-              (setq day-offset 1)
-            (setq day-offset 2)))
+     ;; Compute correct day-offset, so future and today journal entry end in 
the same file
+     (let ((current-date (calendar-current-date))
+           (current-date+1 (calendar-current-date 1)))
+       (if (equal (org-journal--convert-time-to-file-type-time
+                   (org-journal--calendar-date->time current-date) )
+                  (org-journal--convert-time-to-file-type-time
+                   (org-journal--calendar-date->time current-date+1)))
+           (setq day-offset 1)
+         (setq day-offset 2)))
 
-        (let* ((scheduled-entry-date (calendar-current-date day-offset))
-               (scheduled-entry-time (org-journal--calendar-date->time 
scheduled-entry-date))
-               (new-entry-date (calendar-current-date (if (= day-offset 1) nil 
1)))
-               (new-entry-time (org-journal--calendar-date->time 
new-entry-date))
-               ;; TODO(cschwarzgruber): For PR #338
-               ;; "   "
-               ;; org-scheduled-string
-               ;; " "
-               (scheduled-string (concat (format-time-string (cdr 
org-time-stamp-formats) scheduled-entry-time))))
-          ;; Add first scheduled entry
-          (org-journal-new-scheduled-entry nil scheduled-entry-time)
-          (insert "Task 1")
-          ;; Add a second scheduled entry
-          (org-journal-new-scheduled-entry nil scheduled-entry-time)
-          (insert "Task 2")
-          ;; New today entry should be added at the beginning of the journal 
file
-          (org-journal-new-entry 4 new-entry-time)
-          (should (equal (buffer-substring-no-properties (point-min) 
(point-max))
-                         (with-temp-buffer
-                           (insert
-                            (concat
-                             ;; Today entry
-                             "* Test header\n"
-                             ":PROPERTIES:\n"
-                             (concat
-                              ":CREATED:  "
-                              (format-time-string 
org-journal-created-property-timestamp-format new-entry-time)
-                              "\n")
-                             ":END:\n"
+     (let* ((scheduled-entry-date (calendar-current-date day-offset))
+            (scheduled-entry-time (org-journal--calendar-date->time 
scheduled-entry-date))
+            (new-entry-date (calendar-current-date (if (= day-offset 1) nil 
1)))
+            (new-entry-time (org-journal--calendar-date->time new-entry-date))
+            ;; TODO(cschwarzgruber): For PR #338
+            ;; "   "
+            ;; org-scheduled-string
+            ;; " "
+            (scheduled-string (concat "<" (format-time-string (car 
org-time-stamp-formats) scheduled-entry-time) ">")))
+       ;; Add first scheduled entry
+       (org-journal-new-scheduled-entry nil scheduled-entry-time)
+       (insert "Task 1")
+       ;; Add a second scheduled entry
+       (org-journal-new-scheduled-entry nil scheduled-entry-time)
+       (insert "Task 2")
+       ;; New today entry should be added at the beginning of the journal file
+       (org-journal-new-entry 4 new-entry-time)
+       (should (equal (buffer-substring-no-properties (point-min) (point-max))
+                      (with-temp-buffer
+                        (insert
+                         (concat
+                          ;; Today entry
+                          "* Test header\n"
+                          ":PROPERTIES:\n"
+                          (concat
+                           ":CREATED:  "
+                           (format-time-string 
org-journal-created-property-timestamp-format new-entry-time)
+                           "\n")
+                          ":END:\n"
 
-                             ;; Scheduled entries
-                             "* Test header\n"
-                             ":PROPERTIES:\n"
-                             (concat
-                              ":CREATED:  "
-                              (format-time-string 
org-journal-created-property-timestamp-format scheduled-entry-time)
-                              "\n")
-                             ":END:\n"
-                             "** TODO Task 1\n"
-                             scheduled-string
-                             "\n"
-                             ;; (format-time-string "   SCHEDULED: <%F %a>\n" )
-                             "** TODO Task 2\n"
-                             scheduled-string))
-                           (buffer-substring-no-properties (point-min) 
(point-max)))))))))
+                          ;; Scheduled entries
+                          "* Test header\n"
+                          ":PROPERTIES:\n"
+                          (concat
+                           ":CREATED:  "
+                           (format-time-string 
org-journal-created-property-timestamp-format scheduled-entry-time)
+                           "\n")
+                          ":END:\n"
+                          "** TODO Task 1\n"
+                          scheduled-string
+                          "\n"
+                          ;; (format-time-string "   SCHEDULED: <%F %a>\n" )
+                          "** TODO Task 2\n"
+                          scheduled-string))
+                        (buffer-substring-no-properties (point-min) 
(point-max)))))))))