#+TODO: TODO TODAY NEXT STARTED IN-PROGRESS UNDERWAY WAITING SOMEDAY MAYBE CHECK | DONE CANCELED

* Test data

Rather than using my personal agenda every time I want to take a screenshot, how about this.

Will try to open the agenda view as if it was [2017-07-05 Wed]

** TODO [#A] Take over the universe                       :universe:ambition:
DEADLINE: <2017-07-15 Sat -1m>
:PROPERTIES:
:agenda-group: plans
:CATEGORY: ambition
:END:

*** TODO [#A] Take over the world                                     :world:
DEADLINE: <2017-07-07 Fri>

 I'd like to be finished with this before the weekend...

**** TODO [#A] Skype with president of Antarctica            :world:meetings:
SCHEDULED: <2017-07-04 Tue 21:00>

  Not sure what his timezone is...

*** TODO [#B] Take over Mars

**** TODO Visit Mars                                    :space:travel:planet:
DEADLINE: <2017-09-20 Wed -3m>

  Ah, the red planet...

*** TODO [#C] Take over the moon

**** WAITING Visit the moon                                    :space:travel:
DEADLINE: <2017-08-27 Sun -2m>
:LOGBOOK:
-  State "WAITING"    from              [2017-07-24 Mon 19:01]
:END:

  Just waiting on that callback from NASA...

*** TODO Practice leaping tall buildings in a single bound         :personal:
SCHEDULED: <2017-07-05 Wed +2d>
:PROPERTIES:
:STYLE:    habit
:END:

*** TODO [#B] Renew membership in supervillain club
DEADLINE: <2017-07-10 Mon -1w>

*** DONE [#B] Learn universal sign language
CLOSED: [2017-07-05 Wed 03:02]
:PROPERTIES:
:ID:       729de245-75fa-43b4-845a-57af61109485
:END:
:LOGBOOK:
-  CLOSING NOTE [2017-07-05 Wed 03:02] \\
   All done!
CLOCK: [2017-07-05 Wed 02:00]--[2017-07-05 Wed 03:02] =>  1:02
:END:

** TODO Order a pizza                                          :food:dinner:
SCHEDULED: <2017-07-05 Wed 18:00>
:PROPERTIES:
:Effort:   5
:END:

** TODO [#C] Get haircut                                     :personal:@town:
SCHEDULED: <2017-07-05 Wed>

Should probably do this before I take over the world.  Want to look my best.  (Not that it will matter once I'm in charge.)

** TODO [#B] Internet                                                :bills:
DEADLINE: <2017-07-21 Fri -1m>

** TODO [#A] Spaceship lease                               :bills:spaceship:
DEADLINE: <2017-08-01 Tue -1m>
:PROPERTIES:
:agenda-group: bills
:END:

** TODO [#B] Fix flux capacitor               :spaceship:shopping:@computer:
SCHEDULED: <2017-07-05 Wed>

If I don't, the frobnicator will probably fall off halfway to Mars...

Gotta buy one first, though.

** Recurring
:PROPERTIES:
:agenda-group: recurring
:END:

*** CHECK /r/emacs                                            :website:Emacs:
DEADLINE: <2017-07-05 Wed +1w>

*** TODO Shop for groceries                             :food:shopping:@town:
SCHEDULED: <2017-07-05 Wed +1w>
:PROPERTIES:
:Effort:   30
:END:

*** Sunrise/sunset

%%(org-super-agenda--test-diary-sunrise)
%%(org-super-agenda--test-diary-sunset)

** Ideas
:PROPERTIES:
:CATEGORY: ideas
:END:

*** SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming:
SCHEDULED: <2017-07-05 Wed>
:LOGBOOK:
    -  State "SOMEDAY"    from "MAYBE"      [2017-07-24 Mon 18:59]
    -  State "MAYBE"      from              [2017-07-24 Mon 18:58]
    :END:

    I mean, since no one has ever tried doing it before...

*** SOMEDAY Write a symphony                                        :music:
:PROPERTIES:
:agenda-group: plans
:END:

I don't know when I'll get to this, so it's undated.

* Code

#+BEGIN_SRC elisp
  (cl-defun ap/org-tweak-timestamps (&key (offset 0) epoch-ts)
    "Advance all timestamps in the current buffer as if the earliest one was on today.
  OFFSET changes which timestamp (in chronological order) is set to
  today.  Or, if EPOCH-TS is non-nil, use it as the new zero-point
  for today."
    (let* ((tss (->> (org-with-wide-buffer
                      (goto-char (point-min))
                      (cl-loop while (re-search-forward org-ts-regexp-both nil t)
                               collect (ts-parse-org (match-string 0))))
                     (-sort #'ts<)))
           (epoch-ts (if epoch-ts
                         (ts-parse-org epoch-ts)
                       (nth offset tss)))
           (difference-secs (ts-diff (ts-now) epoch-ts))
           (days (floor (/ difference-secs 86400))))
      (org-with-wide-buffer
       (goto-char (point-min))
       (while (re-search-forward org-ts-regexp-both nil t)
         (let* ((ts (ts-parse-org (match-string 0)))
                (timed-p (string-match-p (rx (repeat 2 digit) ":" (repeat 2 digit) (or ">" "]")) (match-string 0)))
                (type (cond ((string-prefix-p "<" (match-string 0)) 'active)
                            ((string-prefix-p "[" (match-string 0)) 'inactive)
                            (t (error "Unknown ts type"))))
                (brackets (cl-ecase type
                            ('active (cons "<" ">"))
                            ('inactive (cons "[" "]"))))
                (format-string (concat (car brackets)
                                       (if timed-p
                                           "%Y-%m-%d %a %H:%M"
                                         "%Y-%m-%d %a")
                                       (cdr brackets)))
                (new-ts (ts-adjust 'day days ts))
                (new-ts-string (ts-format format-string new-ts)))
           (replace-match new-ts-string t t nil 0))))
      (message "Tweaked from epoch: %s" (ts-format epoch-ts))))
#+END_SRC

#+BEGIN_SRC elisp
(org-time-string-to-absolute (org-entry-get (point) "SCHEDULED"))
#+END_SRC

  #+BEGIN_SRC elisp :results none
  ;; Setup code
  (require 'org-super-agenda)
  (org-super-agenda-mode 1)
  (require 'org-habit)
  (setq org-todo-keywords
        '((sequence "TODO(t!)" "TODAY(a!)" "NEXT(n!)" "STARTED(s!)" "IN-PROGRESS(p!)" "UNDERWAY(u!)" "WAITING(w@)" "SOMEDAY(o!)" "MAYBE(m!)" "|" "DONE(d@)" "CANCELED(c@)")
          (sequence "CHECK(k!)" "|" "DONE(d@)")
          (sequence "TO-READ(r!)" "READING(R!)" "|" "HAVE-READ(d@)")
          (sequence "TO-WATCH(!)" "WATCHING(!)" "SEEN(!)")))
  (with-current-buffer "test.org" (revert-buffer))

  (defmacro with-org-today-date (date &rest body)
    "Run BODY with the `org-today' function set to return simply DATE.
  DATE should be a date-time string (both date and time must be included)."
    (declare (indent defun))
    `(let ((day (date-to-day ,date))
           (orig (symbol-function 'org-today)))
       (unwind-protect
           (progn
             (fset 'org-today (lambda () day))
             ,@body)
         (fset 'org-today orig))))
  #+END_SRC

#+BEGIN_SRC elisp  :results none
  (defun diary-sunrise ()
    (let ((dss (diary-sunrise-sunset)))
      (with-temp-buffer
        (insert dss)
        (goto-char (point-min))
        (search-forward ",")
        (buffer-substring (point-min) (match-beginning 0)))))

  (defun diary-sunset ()
    (let ((dss (diary-sunrise-sunset))
          start end)
      (with-temp-buffer
        (insert dss)
        (goto-char (point-min))
        (search-forward ", ")
        (setq start (match-end 0))
        (search-forward " at")
        (setq end (match-beginning 0))
        (goto-char start)
        (capitalize-word 1)
        (buffer-substring start end))))
#+END_SRC

*Note:* Removing tests from here as they're added to =test.el=.

  #+BEGIN_SRC elisp

    (org-super-agenda--test-with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/emacs/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:name "Time grid items in all-uppercase with RosyBrown1 foreground"
                      :time-grid t
                      :transformer (--> it
                                        (upcase it)
                                        (propertize it 'face '(:foreground "RosyBrown1"))))
               (:name "Priority >= C items underlined, on black background"
                      :face (:background "black" :underline t)
                      :not (:priority>= "C")
                      :order 100))))
        (org-agenda nil "a")))
    (org-super-agenda--test-with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/emacs/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:name none
                      :time-grid t)
               (:name "Should be all-uppercase RosyBrown1 on black"
                      :face (:background "black" :foreground "RosyBrown1")
                      :transformer #'upcase
                      :not (:priority>= "C")
                      :order 100))))
        (org-agenda nil "a")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:name none
                      :time-grid t)
               (:name none
                      :not (:priority>= "C")
                      :order 100))))
        (org-agenda nil "a")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:name "Items with child TODOs"
                      :children todo))))
        (org-agenda nil "a")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:name "Items with child TODOs"
                      :children "CHECK"))))
        (org-agenda nil "a")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-agenda-custom-commands
             '(("u" "Super view"
                ((agenda "" ((org-super-agenda-groups
                              '((:name "Today"
                                       :time-grid t
                                       :scheduled today
                                       :deadline today)))))
                 (todo "" ((org-super-agenda-groups
                            '((:name "Projects"
                                     :children t)
                              (:discard (:anything t)))))))))))
        (org-agenda nil "u")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-agenda-custom-commands
             '(("u" "Super view"
                ((agenda "" ((org-super-agenda-groups
                              '((:name "Today"
                                       :time-grid today)))))
                 (todo "" ((org-super-agenda-groups
                            '((:name "Projects"
                                     :children t)
                              (:discard (:anything t)))))))))))
        (org-agenda nil "u")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-agenda-custom-commands
             '(("u" "Super view"
                ((agenda "" ((org-super-agenda-groups
                              '((:name "Schedule"
                                       :time-grid t
                                       :date today)
                                (:name "Due today"
                                       :deadline today)
                                (:name "Due soon"
                                       :deadline t)))))
                 (todo "" ((org-agenda-overriding-header "")
                           (org-super-agenda-groups
                            '((:name "Projects"
                                     :children t)
                              (:discard (:anything t)))))))))))
        (org-agenda nil "u")))

    (with-org-today-date "2017-07-05 00:00"
      (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            (org-super-agenda-groups
             '((:scheduled (before "2017-07-06")))))
        (org-agenda nil "a")))
#+END_SRC

#+BEGIN_SRC elisp

  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:todo "WAITING")))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
      (org-todo-list)))

  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:todo "SOMEDAY")))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
      (org-tags-view nil "Emacs")))

  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:todo "CHECK")))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
;; org-search-view doesn't seem to set the todo-state property, so the matcher doesn't work
      (org-search-view nil "Emacs")))

  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:regexp ("moon" "mars"))))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
      (org-search-view nil "space")))

  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:todo "SOMEDAY")))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
      (org-agenda-list nil nil 'day)))

#+END_SRC

** Agenda examining

This helps a lot.

#+BEGIN_SRC elisp
  (defun data-debug-show-string-with-properties (s)
    (with-current-buffer (get-buffer-create "argh")
      (erase-buffer)
      (print s (current-buffer))

      ;; Convert string reader representations to plain lists that can be set
      (cl-loop for (match replace) in '(("#(" "'(")
                                        ("#<" "'(")
                                        (">" ")"))
               do (progn
                    (goto-char (point-min))
                    (while (search-forward match nil 'noerror)
                      (replace-match replace 'fixedcase 'literal))))

      ;; Surround content in a list which `argh' is set to, then eval
      ;; the buffer to do it
      (goto-char (point-min))
      (insert "(setq argh (list '")
      (delete-forward-char 2)
      (goto-char (point-max))
      (insert "))")

      ;; Okay, sure, eval'ing the buffer is dangerous and bad and wrong.
      ;; But this is the only way I can find to make this work.  (Maybe
      ;; `text-properties-at' could be used to get actual lists...)
      (eval-buffer)

      (data-debug-show-stuff argh "argh")
      ;;  (switch-to-buffer (current-buffer))
      ))

  (defun data-debug-show-current-line-with-properties ()
    (interactive)
    (data-debug-show-string-with-properties (buffer-substring (line-beginning-position) (line-end-position))))

  (with-current-buffer "*Org Agenda*"
    (data-debug-show-string-with-properties (seq-subseq (split-string (buffer-string) "\n")
                                                        0 5)))
#+END_SRC

** Agenda censoring

For sharing screenshots of the agenda without revealing private data.

#+BEGIN_SRC elisp
  (defun org-agenda-sharpie ()
    "Censor the text of items in the agenda."
    (interactive)
    (let (regexp old-heading new-heading properties)
      ;; Save face properties of line in agenda to reapply to changed text
      (setq properties (text-properties-at (point)))

      ;; Go to source buffer
      (org-with-point-at (org-find-text-property-in-string 'org-marker
                                                           (buffer-substring (line-beginning-position)
                                                                             (line-end-position)))
        ;; Save old heading text and ask for new text
        (line-beginning-position)
        (unless (org-at-heading-p)
          ;; Not sure if necessary
          (org-back-to-heading))
        (setq old-heading (when (looking-at org-complex-heading-regexp)
                            (match-string 4))))
      (setq new-heading (read-from-minibuffer "Overwrite visible heading with: "))
      (add-text-properties 0 (length new-heading) properties new-heading)
      ;; Back to agenda buffer
      (save-excursion
        (when (and old-heading new-heading)
          ;; Replace agenda text
          (let ((inhibit-read-only t))
            (goto-char (line-beginning-position))
            (when (search-forward old-heading (line-end-position))
              (replace-match new-heading 'fixedcase 'literal)))))))
#+END_SRC

** Auto grouping


#+BEGIN_SRC elisp
  (with-org-today-date "2017-07-05 00:00"
    (let ((org-super-agenda-groups
           '((:auto-group t)))
          (org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
      (org-agenda-list nil nil 'day)))
#+END_SRC

** Auto categories

#+BEGIN_SRC elisp
  (let ((org-super-agenda-groups
         '((:auto-category t))))
    (org-agenda-list nil nil 'day))
#+END_SRC

** Date

#+BEGIN_SRC elisp
  (with-org-today-date "2017-07-05 00:00"
    (-let* ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            ((sec minute hour day month year dow dst utcoff) (list 0 0 0 5 7 2017 3 t nil))
            (last-day-of-month
             ;; A hack that seems to work fine
             (1+ (calendar-last-day-of-month month year)))
            (target-date (format "%d-%02d-%02d" year month last-day-of-month))
            (org-super-agenda-groups
             `((:deadline (before ,target-date))
               (:discard (:anything t)))))
      (org-todo-list)))

  (with-org-today-date "2017-07-05 00:00"
    (-let* ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
            (org-agenda-span 'day)
            ((sec minute hour day month year dow dst utcoff) (list 0 0 0 5 7 2017 3 t nil))
            (last-day-of-month  (calendar-last-day-of-month month year))
            (target-date (format "%d-%02d-%02d" year month last-day-of-month))
            (org-super-agenda-groups
             `((:deadline (before ,target-date))
               (:discard (:anything t)))))
      (org-todo-list)))
#+END_SRC

** Effort

#+BEGIN_SRC elisp
  (with-org-today-date "2017-07-05 00:00"
    (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
          (org-super-agenda-groups
           '((:effort< "0:06"))))
      (org-agenda-list nil nil 'day)))
#+END_SRC

** Misc

*** let-plist

I don't need this right now, but it might come in handy here or elsewhere.

#+BEGIN_SRC elisp
  (defmacro osa/let-plist (keys plist &rest body)
    "`cl-destructuring-bind' without the boilerplate for plists."
    ;; See https://emacs.stackexchange.com/q/22542/3871

    ;; I really don't understand why Emacs doesn't have this already.
    ;; So many things come close to it: pcase, pcase-let, map-let,
    ;; cl-destructuring-bind, -let...but none of them let you simply
    ;; bind all the values of a plist to variables with the same name as
    ;; their keys. You always have to type the name of the key twice.

    ;; For example, compare these two forms:

    ;; (-let (((&keys :from from :to to :date date :subject subject) email))
    ;;   (list from to date subject))

    ;; (osa/let-plist (:from :to :date :subject) email
    ;;   (list from to date subject))

    ;; Now, sure, sometimes you need to bind values to differently named
    ;; variables. But when you don't, I know which one I prefer.
    (declare (indent defun))
    (setq keys (cl-loop for key in keys
                        collect (intern (replace-regexp-in-string (rx bol ":") ""
                                                                  (symbol-name key)))))
    `(cl-destructuring-bind
         (&key ,@keys &allow-other-keys)
         ,plist
       ,@body))
#+END_SRC

** Profiling

#+BEGIN_SRC elisp :results none
  (defmacro profile-it (times &rest body)
    `(let (output)
       (dolist (p '("org-super-agenda-" "map" "org-" "string-" "s-" "buffer-" "append" "delq" "map" "list" "car" "save-" "outline-" "delete-dups" "sort" "line-" "nth" "concat" "char-to-string" "rx-" "goto-" "when" "search-" "re-"))
         (elp-instrument-package p))
       (dotimes (x ,times)
         ,@body)
       (elp-results)
       (elp-restore-all)
       (point-min)
       (forward-line 20)
       (delete-region (point) (point-max))
       (setq output (buffer-substring-no-properties (point-min) (point-max)))
       (kill-buffer)
       (delete-window)
       output))
#+END_SRC
