org-journal-toc

journal-toc.el

;;;; journal.el starts here

(require 'org)
(require 'org-journal "fstorm-org/org-journal")

;;;###autoload
(defun org-journal--toc ()
  (interactive)
  (let ((bufname "*Org journal toc*"))
    (with-current-buffer-window
     bufname '((display-buffer-same-window)) nil
     (org-mode)
     (org-journal--toc-print)
     (show-all))))

(defun org-journal--toc-print ()
  (local-set-key [?s] 'org-journal-search)
  (local-set-key [?g] 'org-journal--toc)
  (local-set-key [?q] 'kill-this-buffer)
  (local-set-key [tab] 'forward-button)
  (local-set-key [backtab] 'backward-button)
  (local-set-key [?n] 'forward-button)
  (local-set-key [?p] 'backward-button)
  (let ((journal-files (directory-files org-journal-dir t org-journal-file-pattern t)))
    (cl-mapcar
     #'(lambda (fname parse-tree)
         (let ((title   (car parse-tree))
               (outline (cdr parse-tree)))
           ;; title
           (unless (stringp title) (setq title ""))
           (insert "\n* " title "\n\n")
           (dolist (o outline)
             (let ((title (car o))
                   (pos   (cdr o)))
               (unless (stringp title) (setq title ""))
               (insert org-journal-time-prefix)
               (insert-text-button title
                                   'action 'org-journal--toc-follow-link-action
                                   'toc/file fname 'toc/pos pos)
               (insert "\n")))))
     journal-files
     (mapcar
      #'(lambda (f)
          (with-temp-buffer
            (let (acc title tp)
              (insert-file-contents f)
              (goto-char (point-max))
              (while (setq tp (outline-previous-heading))
                (setq acc (cons (cons (org-get-heading) tp) acc)))
              (if (search-forward "#+title" nil t)
                  (let ((elem (org-element-at-point)))
                    (setq title (org-element-property :value elem)))
                (setq title (file-name-base f)))
              (cons title acc))))
      journal-files))))

(defun org-journal--toc-follow-link-action (button)
  (let ((fname (button-get button 'toc/file))
        (pos   (button-get button 'toc/pos)))
    (find-file fname)
    (when (integerp pos) (goto-char pos))))

;;;; journal.el ends here