#+TITLE: Org Mode
#+STARTUP: content

* Base

#+begin_src emacs-lisp
;;; org-mode.el --- Org-mode configuration -*- lexical-binding: t; -*-

;; Base directory
(setq org-directory "~/pims")

;; Org files
(defvar circ/org-inbox-file (expand-file-name "inbox.org" org-directory))
(defvar circ/org-todo-file (expand-file-name "todo.org" org-directory))
(defvar circ/org-reference-directory (expand-file-name "reference" org-directory))

;; Only scan todo.org for agenda
(setq org-agenda-files (list circ/org-inbox-file circ/org-todo-file))

;; Workflow states
(setq org-todo-keywords
      '((sequence "TODO(t)" "NEXT(n)" "INPROGRESS(i)" "WAIT(w)" "|" "DONE(d)" "CANCELLED(c)")))

;; Make org-agenda use current window
(setq org-agenda-window-setup 'current-window)

;; Archive location
(setq org-archive-location "~/pims/archive.org::* Archived")

;; Log completion time when a task is marked done
(setq org-log-done 'time)

;; Hide leading stars in the org view
(setq org-hide-leading-stars t)

;; Soft word wrap at window edge
(add-hook 'org-mode-hook #'visual-line-mode)

;; Make capture buffer respect display-buffer-alist
(setq org-capture-switch-to-buffer-fn #'pop-to-buffer)

;; Disable org-mode's default indenting of every code block line
(setq org-edit-src-content-indentation 0)

;; Open org-edit-special in the current window
(setq org-src-window-setup 'current-window)

;; TODO: Comment these
(require 'org-habit)
(setq org-enforce-todo-dependencies t)
(setq org-track-ordered-property-with-tag t)
(setq org-agenda-todo-ignore-deadlines 'nil)
(setq org-agenda-todo-ignore-scheduled 'nil)
(setq org-agenda-tags-todo-honor-ignore-options t)
(setq org-agenda-dim-blocked-tasks 'invisible)
(setq org-agenda-log-mode-items '(state closed clock))
(setq org-tag-persistent-alist nil)
(setq org-agenda-tags-column -80)
(setq org-habit-graph-column 60)

(setq org-agenda-start-day "-4d")
(setq org-agenda-start-on-weekday nil)
(setq org-agenda-span 14)

(setq org-agenda-sorting-strategy '((agenda habit-down time-up priority-down category-keep)
                                    (todo priority-down category-keep)
                                    (tags priority-down category-up tag-up)
                                    (search category-keep)))

(setq org-link-abbrev-alist
      '(("ref"     . "file:~/pims/reference/%s")
        ("pims"    . "file:~/pims/%s")
        ("ddg"     . "https://duckduckgo.com/?q=%s")
        ("google"  . "http://www.google.com/search?q=")))

;; Don't show any habits in the agenda, there is a dedicated section for that.
(setq org-habit-show-habits nil)
(setq org-habit-show-habits-only-for-today nil)
(setq org-habit-show-all-today nil)

(setq org-use-property-inheritance t)
(setq org-clock-into-drawer "CLOCK")
(setq org-clock-mode-line-total 'current)
(setq org-agenda-window-setup 'current-window)
(setq org-agenda-sticky t)
(setq org-log-done 'time)
(setq org-agenda-skip-scheduled-if-done t)
(setq org-agenda-skip-deadline-if-done t)
(setq org-time-stamp-rounding-minutes '(1 1))
(setq org-clock-out-when-done nil)
(setq org-log-into-drawer "LOGBOOK")
(setq org-hide-emphasis-markers t)

(setq org-agenda-clock-consistency-checks
      (quote (:max-duration "4:00"
              :min-duration 0
              :max-gap 0
              :gap-ok-around ("4:00"))))
(defun circ/org-agenda-mode-startup-functions ()
  (hl-line-mode +1))
(add-hook 'org-agenda-mode-hook 'circ/org-agenda-mode-startup-functions)

(defvar circ/org-habit-show-graphs-everywhere t
  "If non-nil, show habit graphs in all types of agenda buffers.

Normally, habits display consistency graphs only in
\"agenda\"-type agenda buffers, not in other types of agenda
buffers.  Set this variable to any non-nil variable to show
consistency graphs in all Org mode agendas.")

(defun circ/org-agenda-mark-habits ()
  "Mark all habits in current agenda for graph display.

This function enforces `circ/org-habit-show-graphs-everywhere' by
marking all habits in the current agenda as such.  When run just
before `org-agenda-finalize' (such as by advice; unfortunately,
`org-agenda-finalize-hook' is run too late), this has the effect
of displaying consistency graphs for these habits.

When `circ/org-habit-show-graphs-everywhere' is nil, this function
has no effect."
  (when (and circ/org-habit-show-graphs-everywhere
         (not (get-text-property (point) 'org-series)))
    (let ((cursor (point))
          item data)
      (while (setq cursor (next-single-property-change cursor 'org-marker))
        (setq item (get-text-property cursor 'org-marker))
        (when (and item (org-is-habit-p item))
          (with-current-buffer (marker-buffer item)
            (setq data (org-habit-parse-todo item)))
          (put-text-property cursor
                             (next-single-property-change cursor 'org-marker)
                             'org-habit-p data))))))

(advice-add #'org-agenda-finalize :before #'circ/org-agenda-mark-habits)

#+end_src

* Tag Cloud for Org Agenda
#+BEGIN_SRC emacs-lisp
(defvar-local circ/org-agenda-filter-list-tags nil)
(defvar-local circ/org-agenda-filter-list-effort nil)
(defvar-local circ/org-agenda-filter-list-categories nil)

(defun circ/agenda-count-tags ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((count-alist '())
          (last-pos 0))
      (while (not (= last-pos (progn
                                (ignore-errors (org-agenda-next-item 1))
                                (move-beginning-of-line nil))))
        (setq last-pos (point))
        (dolist (tag (org-get-at-bol 'tags))
          (let* ((alist-val (assoc tag count-alist))
                 (count (cond ((not alist-val) 0)
                              (t (cdr alist-val)))))
            (setq count-alist (circ/alist-set tag (1+ count) count-alist)))))
      count-alist)))

(defun circ/agenda-format-tag-cloud (tag-alist)
  (interactive)
  (let ((string "  ")
        (text-width (window-text-width))
        (line-length 0))
    (dolist (tag (sort tag-alist (lambda (a b) (> (cdr a) (cdr b)))))
      (let ((tag-name (propertize (car tag) 'face 'org-tag))
            (tag-count (cdr tag)))
        (unless (member tag-name '("proj" "ordered"))
          (let ((tag-string (format "%s (%s)  " tag-name tag-count)))
            ;; Magic number 3 to help avoid the overflow icon. Sometimes, if the
            ;; tags are just right, the tag cloud will show an icon that
            ;; indicates there is more text off the side of the buffer. I don't
            ;; ever want that, because it makes me wonder if any tags are
            ;; missing from my immediate view.
            (cond ((> (+ line-length (length tag-string) 3) text-width)
                   (setq string (concat string "\n  " tag-string))
                   (setq line-length (+ (length tag-string) 2)))
                  (t
                   (setq string (concat string tag-string))
                   (setq line-length (+ line-length (length tag-string)))))))))
    string))

(defun circ/alist-set (key val alist &optional symbol)
  "Set property KEY to VAL in ALIST. Return new alist.
This creates the association if it is missing, and otherwise sets
the cdr of the first matching association in the list. It does
not create duplicate associations. By default, key comparison is
done with `equal'. However, if SYMBOL is non-nil, then `eq' is
used instead.

This method may mutate the original alist, but you still need to
use the return value of this method instead of the original
alist, to ensure correct results."
  (if-let ((pair (if symbol (assq key alist) (assoc key alist))))
      (setcdr pair val)
    (push (cons key val) alist))
  alist)

(defun circ/org-agenda-insert-tag-cloud ()
  (interactive)
  ;; Check the buffer name and the existance of a "===" line.
  (when (and (string= (buffer-name) "*Org Agenda(T)*")
             (save-excursion
               (goto-char (point-min))
               (search-forward-regexp "^==*" nil t)))
    (save-excursion
      (read-only-mode 0)
      ;; Remove tags if exists
      (goto-char (point-min))
      (when (ignore-errors (search-forward-regexp "^Tag Cloud"))
        (search-forward-regexp "^\*\**\n")
        (move-beginning-of-line 2)
        (delete-region (point-min) (point)))

      (goto-char (point-min))
      (insert (propertize (format
                           "Tag Cloud (Tag Filter: %s, Effort Filter:  %s, Cat Filter: %s)\n"
                           (string-join circ/org-agenda-filter-list-tags " ")
                           (string-join circ/org-agenda-filter-list-effort " ")
                           (string-join circ/org-agenda-filter-list-categories " "))
                          'face 'org-agenda-structure)
              (circ/agenda-format-tag-cloud (circ/agenda-count-tags)) "\n\n"
              (make-string (- (window-width) 1) ?*) "\n")
      (read-only-mode 1))))

;; Could improve performance by caching the alist from `circ/agenda-count-tags'
;; but there is some problem with setting it. It doesn't set correcly. Don't
;; know why.
(defun circ/org-agenda-filter-tag ()
  (interactive)
  (let* ((tag-list (mapcar 'car (circ/agenda-count-tags)))
         (tag-candidates (cl-remove-duplicates
                          (append (mapcar (lambda (tag) (concat "+" tag)) tag-list)
                                  (mapcar (lambda (tag) (concat "-" tag)) tag-list)
                                  circ/org-agenda-filter-list-tags)
                          :test 'string=))
         (new-tag (completing-read "Tag: " tag-candidates)))
    (cond ((member new-tag circ/org-agenda-filter-list-tags)
           (setq circ/org-agenda-filter-list-tags (remove new-tag circ/org-agenda-filter-list-tags))
           (circ/org-agenda-redo))
          (t
           (setq circ/org-agenda-filter-list-tags (cons new-tag circ/org-agenda-filter-list-tags))))
    (circ/org-agenda-apply-filter)))

(defun circ/org-agenda-apply-filter ()
  (interactive)
  (when circ/org-agenda-filter-list-tags
    (org-agenda-filter-apply circ/org-agenda-filter-list-tags 'tag))
  (when circ/org-agenda-filter-list-effort
    (org-agenda-filter-apply circ/org-agenda-filter-list-effort 'effort))
  (when circ/org-agenda-filter-list-categories
    (org-agenda-filter-apply circ/org-agenda-filter-list-categories 'category))
  (run-hooks 'org-agenda-filter-hook))

(defun circ/org-agenda-show-all-tags ()
  (interactive)
  (setq circ/org-agenda-filter-list-tags nil)
  (org-agenda-filter-show-all-tag)
  (circ/org-agenda-redo))

(defun circ/org-agenda-redo ()
  (interactive)
  (let ((filter-list-tags circ/org-agenda-filter-list-tags)
        (filter-list-effort circ/org-agenda-filter-list-effort)
        (filter-list-categories circ/org-agenda-filter-list-categories))
    (org-agenda-redo)
    (setq circ/org-agenda-filter-list-tags filter-list-tags)
    (setq circ/org-agenda-filter-list-effort filter-list-effort)
    (setq circ/org-agenda-filter-list-categories filter-list-categories)
    (circ/org-agenda-apply-filter)))

(add-hook 'org-agenda-finalize-hook 'circ/org-agenda-insert-tag-cloud)
(add-hook 'org-agenda-filter-hook 'circ/org-agenda-insert-tag-cloud)


(defun circ/org-agenda-filter-effort ()
  (interactive)
  (let* ((effort-list (split-string
                       (or (cdr (assoc-string (concat org-effort-property "_ALL")
                                              org-global-properties
                                              t))
                           "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
         (effort-candidates (append (mapcar (lambda (e) (concat "<= " e)) effort-list)
                                    (mapcar (lambda (e) (concat "== " e)) effort-list)
                                    (mapcar (lambda (e) (concat ">= " e)) effort-list)))
         (new-effort (concat "+" (replace-regexp-in-string "^<= " "<"
                                   (replace-regexp-in-string "^== " "="
                                     (replace-regexp-in-string "^>= " ">"
                                  (completing-read "Effort: " effort-candidates)))))))
    (cond ((member new-effort circ/org-agenda-filter-list-effort)
           (setq circ/org-agenda-filter-list-effort (remove new-effort circ/org-agenda-filter-list-effort))
           (circ/org-agenda-redo))
          (t
           (setq circ/org-agenda-filter-list-effort (cons new-effort circ/org-agenda-filter-list-effort))))
    (circ/org-agenda-apply-filter)))

(defun circ/org-agenda-show-all-efforts ()
  (interactive)
  (setq circ/org-agenda-filter-list-effort nil)
  (org-agenda-filter-show-all-effort)
  (circ/org-agenda-redo))

(defun circ/org-agenda-filter-category ()
  (interactive)
  (let* ((category-list (circ/org-agenda-get-categories))
         (category-candidates (cl-remove-duplicates
                               (append (mapcar (lambda (c) (concat "+" c)) category-list)
                                       (mapcar (lambda (c) (concat "-" c)) category-list)
                                       circ/org-agenda-filter-list-categories)
                               :test 'string=))
         (new-category (completing-read "Category: " category-candidates)))
    (cond ((member new-category circ/org-agenda-filter-list-categories)

           (setq circ/org-agenda-filter-list-categories (remove new-category circ/org-agenda-filter-list-categories))
           (circ/org-agenda-redo))
          (t
           (setq circ/org-agenda-filter-list-categories (cons new-category circ/org-agenda-filter-list-categories))))
    (circ/org-agenda-apply-filter)))

(defun circ/org-agenda-get-categories ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((category-list '())
          (last-pos 0))
      (while (not (= last-pos (progn
                                (ignore-errors (org-agenda-next-item 1))
                                (move-beginning-of-line nil))))
        (setq last-pos (point))
        (let ((category (org-get-at-bol 'org-category)))
          (when (and category (not (member category category-list)))
            (setq category-list (cons category category-list)))))
      category-list)))

(defun circ/org-agenda-show-all-categories ()
  (interactive)
  (setq circ/org-agenda-filter-list-categories nil)
  (org-agenda-filter-show-all-cat)
  (circ/org-agenda-redo))
#+END_SRC

* Refile

#+begin_src emacs-lisp
(setq org-refile-targets `((,circ/org-todo-file :maxlevel . 99)))
(setq org-refile-use-outline-path 'file)
(setq org-outline-path-complete-in-steps nil)
(setq org-refile-allow-creating-parent-nodes 'confirm)
#+end_src

* Agenda

#+begin_src emacs-lisp
(setq org-agenda-start-day "-4d")
(setq org-agenda-start-on-weekday nil)
(setq org-agenda-span 14)

(setq org-agenda-custom-commands
      '(("A" "Agenda" ((agenda "")
                       (tags-todo "STYLE=\"habit\"" ((org-agenda-overriding-header
                                                      "Habits\nBlue:   Not to be done          !: Today\nGreen:  Could have been done    *: Done that day\nYellow: Overdue the next day\nRed:    Overdue that day                                                   Today V")))
                       (tags "STYLE=\"timebucket\"" ((org-agenda-overriding-header "Time Buckets")))
                       (tags "+CATEGORY=\"inbox\"" ((org-agenda-overriding-header "Inbox")))
                       (tags "+PROJ&+CATEGORY=\"\"" ((org-agenda-overriding-header "Projects Without Category")))))
        ("T" "Tasks" ((tags "+PINNED=\"t\"-TODO=\"DONE\"-TODO=\"CANCELLED\"" ((org-agenda-overriding-header "Pinned")))
                      (tags "+TODO=\"INPROGRESS\"" ((org-agenda-overriding-header "In Progress")))
                      (tags "+TODO=\"TODO\"-DEADLINE={.+}-SCHEDULED={.+}" ((org-agenda-overriding-header "Todo")))
                      (tags "+TODO=\"WAIT\"" ((org-agenda-overriding-header "Wait")))
                      (stuck "" ((org-agenda-overriding-header "Stuck")))))
        ("x" "x" ((tags-todo "+TODO=\"PROJECT\"")))))

(setq org-agenda-sorting-strategy '((agenda habit-down time-up priority-down category-keep)
                                    (todo priority-down category-keep)
                                    (tags priority-down category-up tag-up)
                                    (search category-keep)))

(setq org-stuck-projects '("+PROJ/-DONE-CANCELLED" ("TODO" "WAIT" "INPROGRESS") nil ""))

(setq org-agenda-prefix-format '((agenda   . " %i %-12:c %-6:e%?-12t% s")
                                (timeline . "  % s")
                                (todo     . " %i %-12:c")
                                (tags     . " %i %-12:c %-6:e")
                                (search   . " %i %-12:c")))
#+end_src

* Capture

#+begin_src emacs-lisp
(setq org-default-notes-file circ/org-inbox-file)

(setq org-capture-templates
      '(("t" "Todo" entry (file circ/org-inbox-file)
         "* TODO %?\n:CREATED: %U\n")
        ("n" "Note" entry (file circ/org-inbox-file)
         "* %?\n:CREATED: %U\n")))
#+end_src

* Faces
#+begin_src emacs-lisp
(with-eval-after-load 'org
  (set-face-attribute 'org-level-1 nil :foreground "#ff527d")
  (set-face-attribute 'org-level-2 nil :foreground "#3cb44b")
  (set-face-attribute 'org-level-3 nil :foreground "#ffe119")
  (set-face-attribute 'org-level-4 nil :foreground "#4363d8")
  (set-face-attribute 'org-level-5 nil :foreground "#f58231")
  (set-face-attribute 'org-level-6 nil :foreground "#911eb4")
  (set-face-attribute 'org-level-7 nil :foreground "#42d4f4")
  (set-face-attribute 'org-level-8 nil :foreground "#f032e6")
  (set-face-attribute 'org-block nil :background 'unspecified)
  (set-face-attribute 'org-block-begin-line nil :foreground "#9ece6a" :background "#1a2218")
  (set-face-attribute 'org-block-end-line nil :foreground "#9ece6a" :background "#1a2218")
  (set-face-attribute 'org-hide nil :foreground "#000000"))
#+end_src

* Redefinitions

These override built-in org functions to prevent them from destroying
the window layout.

#+begin_src emacs-lisp
;; Prevent org-capture from calling `delete-other-windows', so the
;; current window layout is preserved when capturing.
(with-eval-after-load 'org-capture
  (advice-add 'org-capture-place-template :around
              (lambda (orig-fn &rest args)
                (cl-letf (((symbol-function 'delete-other-windows) #'ignore))
                  (apply orig-fn args)))))

;; Same idea for the agenda dispatcher: don't nuke windows, and use
;; `switch-to-buffer' instead of splitting into another window.
(advice-add 'org-agenda-get-restriction-and-command :around
            (lambda (orig-fn &rest args)
              (cl-letf (((symbol-function 'delete-other-windows) #'ignore)
                        ((symbol-function 'org-switch-to-buffer-other-window) #'switch-to-buffer))
                (apply orig-fn args))))

;; Override `org-fast-todo-selection' to stop it from deleting other
;; windows and splitting the frame.  The only substantive change from
;; the original is in the non-expert branch: instead of deleting
;; windows and splitting vertically, we just switch to the *Org todo*
;; buffer in another window via `org-switch-to-buffer-other-window'.
(defun circ/org-fast-todo-selection (&optional current-state)
  "Fast TODO keyword selection with single keys.
Returns the new TODO keyword, or nil if no state change should occur.
When CURRENT-STATE is given and selection letters are not unique globally,
prefer a state in the current sequence over on in another sequence."
  (let* ((fulltable org-todo-key-alist)
	 (head (org-get-todo-sequence-head current-state))
	 (done-keywords org-done-keywords) ;; needed for the faces.
	 (maxlen (apply 'max (mapcar
			      (lambda (x)
				(if (stringp (car x)) (string-width (car x)) 0))
			      fulltable)))
	 (expert (equal org-use-fast-todo-selection 'expert))
	 (prompt "")
	 (fwidth (+ maxlen 3 1 3))
	 (ncol (/ (- (window-width) 4) fwidth))
	 tg cnt e c tbl subtable
	 groups ingroup in-current-sequence)
    (save-excursion
      (save-window-excursion
	(if expert
	    (set-buffer (get-buffer-create " *Org todo*"))
	  (org-switch-to-buffer-other-window " *Org todo*"))
	(erase-buffer)
	(setq-local org-done-keywords done-keywords)
	(setq tbl fulltable cnt 0)
	(while (setq e (pop tbl))
	  (cond
	   ((equal e '(:startgroup))
	    (push '() groups) (setq ingroup t)
	    (unless (= cnt 0)
	      (setq cnt 0)
	      (insert "\n"))
	    (setq prompt (concat prompt "{"))
	    (insert "{ "))
	   ((equal e '(:endgroup))
	    (setq ingroup nil cnt 0 in-current-sequence nil)
	    (setq prompt (concat prompt "}"))
	    (insert "}\n"))
	   ((equal e '(:newline))
	    (unless (= cnt 0)
	      (setq cnt 0)
	      (insert "\n")
	      (setq e (car tbl))
	      (while (equal (car tbl) '(:newline))
		(insert "\n")
		(setq tbl (cdr tbl)))))
	   (t
	    (setq tg (car e) c (cdr e))
	    (if (equal tg head) (setq in-current-sequence t))
	    (when ingroup (push tg (car groups)))
	    (when in-current-sequence (push e subtable))
	    (setq tg (org-add-props tg nil 'face
				    (org-get-todo-face tg)))
	    (when (and (= cnt 0) (not ingroup)) (insert "  "))
	    (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
	    (insert "[" c "] " tg (make-string
				   (- fwidth 4 (length tg)) ?\ ))
	    (when (and (= (setq cnt (1+ cnt)) ncol)
		       ;; Avoid lines with just a closing delimiter.
		       (not (equal (car tbl) '(:endgroup))))
	      (insert "\n")
	      (when ingroup (insert "  "))
	      (setq cnt 0)))))
	(insert "\n")
	(goto-char (point-min))
	(unless expert (org-fit-window-to-buffer))
	(message (concat "[a-z..]:Set [SPC]:clear"
			 (if expert (concat "\n" prompt) "")))
	(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
	(setq subtable (nreverse subtable))
	(cond
	 ((or (= c ?\C-g)
	      (and (= c ?q) (not (rassoc c fulltable))))
	  (setq quit-flag t))
	 ((= c ?\ ) nil)
	 ((setq e (or (rassoc c subtable) (rassoc c fulltable))
		tg (car e))
	  tg)
	 (t (setq quit-flag t)))))))
(advice-add 'org-fast-todo-selection :override
            #'circ/org-fast-todo-selection)

;; Make `org-agenda-goto' open the entry in the same window instead
;; of splitting into another window.
(advice-add 'org-agenda-goto :around
            (lambda (orig-fn &rest args)
              (cl-letf (((symbol-function 'switch-to-buffer-other-window) #'switch-to-buffer))
                (apply orig-fn args))))
#+end_src

* org-set-tags
#+BEGIN_SRC emacs-lisp
(defun circ/org-set-tags ()
  (interactive)
  (let* ((curr-tags (org-get-tags nil t))
         (new-tags (cl-set-difference
                    (mapcar 'car (org-global-tags-completion-table))
                    curr-tags
                    :test 'string=))
         (completion-list (append
                           '("<DONE>")
                           (sort (mapcar (lambda (tag)
                                           (concat "+" tag))
                                         new-tags)
                                 'string<)
                           (sort (mapcar (lambda (tag)
                                           (concat "-" tag))
                                         curr-tags)
                                 'string<)))
         (tag-change (completing-read "Tag: " completion-list))
         (remove (string= "-" (substring tag-change 0 1)))
         (tag (if (or (string= "-" (substring tag-change 0 1))
                      (string= "+" (substring tag-change 0 1)))
                  (substring tag-change 1)
                tag-change))
         (tags (cl-remove "" (if remove
                               (remove tag curr-tags)
                             (cons tag curr-tags))
                        :test 'string=)))
    (if (not (string= tag-change "<DONE>"))
        (progn
          (org-set-tags-to tags)
          (org--align-tags-here org-tags-column)
          (circ/org-set-tags)))))

(defun circ/org-clear-tags ()
  (interactive)
  (org-set-tags-to nil))
#+END_SRC

* Pims References
#+begin_src emacs-lisp
(setq circ/pims/reference-directory (expand-file-name "~/pims/reference/"))

(defun circ/org-file-reference ()
  (interactive)
  (let* ((target-file (expand-file-name
                       (completing-read "File reference (C-M-j to done): "
                                        (mapcar (lambda (filepath)
                                                  (file-relative-name
                                                   filepath
                                                   circ/org-reference-directory))
                                                (directory-files-recursively
                                                 circ/org-reference-directory
                                                 ".*\.org"
                                                 nil)))
                       circ/org-reference-directory))
         (org-heading (org-get-heading)))
    (org-back-to-heading)
    (org-cut-subtree)

    (find-file target-file)
    (let ((target-buffer (get-file-buffer target-file)))
      (unless (file-exists-p target-file)
        (make-directory (file-name-directory target-file) t)
        (with-current-buffer target-buffer
          (insert (concat "#+TITLE: " org-heading))
          (newline))
        (message "Created file"))
      (with-current-buffer target-buffer
        (end-of-buffer)
        (newline)
        (yank)
        (save-buffer)))))

(defun circ/pims/list-reference-files ()
  (mapcar (lambda (file)
            (replace-regexp-in-string (regexp-quote (expand-file-name circ/pims/reference-directory))
                                      "" file))
          (directory-files-recursively circ/pims/reference-directory "")))

(defun circ/pims/reference-completing-read (&optional initial-input)
  (completing-read "Reference: "
                   (circ/pims/list-reference-files)
                   nil nil initial-input))

(defun circ/pims/find-reference ()
  (interactive)
  (let* ((filepath (circ/pims/reference-completing-read))
         (full-filepath (concat (expand-file-name circ/pims/reference-directory) filepath)))
    (message "filepath: %s" filepath)
    (message "full-filepath: %s" full-filepath)
    (circ/ensure-file full-filepath)
    (find-file full-filepath)))

(defun circ/pims/insert-reference-link ()
  (interactive)
  (let* ((filepath (circ/pims/reference-completing-read))
         (description (read-string "Description: " (concat "Ref: " filepath)))
         (org-link (concat "ref:" filepath))
         (full-filepath (concat (expand-file-name circ/pims/reference-directory) filepath)))
    (circ/ensure-file full-filepath)
    (insert (org-make-link-string org-link description))))

(defun circ/ensure-file (filepath)
  (unless (file-exists-p filepath)
    (make-directory (file-name-directory filepath) t)
    (write-region (concat "#+TITLE: "
                   (capitalize (replace-regexp-in-string
                                "_" " " (file-name-base filepath))))
                  nil filepath)))

(defun circ/pims/reference-directories ()
  (seq-uniq
   (mapcar (lambda (f)
             (replace-regexp-in-string "/$" ""
                                       (file-name-directory f)))
           (circ/pims/list-reference-files))))
#+end_src

* Surround
#+BEGIN_SRC emacs-lisp
(defun circ/surround-parentheses () (interactive) (circ/surround "(" ")"))
(defun circ/surround-brackets    () (interactive) (circ/surround "[" "]"))
(defun circ/surround-braces      () (interactive) (circ/surround "{" "}"))
(defun circ/surround-asterisk    () (interactive) (circ/surround "*" "*"))
(defun circ/surround-d-quote     () (interactive) (circ/surround "\"" "\""))
(defun circ/surround-s-quote     () (interactive) (circ/surround "'" "'"))
(defun circ/surround-slash       () (interactive) (circ/surround "/" "/"))
(defun circ/surround-equals      () (interactive) (circ/surround "=" "="))
(defun circ/surround-plus        () (interactive) (circ/surround "+" "+"))
(defun circ/surround-minus       () (interactive) (circ/surround "-" "-"))

(defun circ/surround-region ()
  (interactive)
  (let* ((start (read-string "Beginning: "))
         (end (read-string "End: " start)))
    (circ/surround start end)))

(defun circ/surround (start end)
  (let ((region (buffer-substring (region-beginning) (region-end))))
    (delete-region (region-beginning) (region-end))
    (insert (format "%s%s%s" start region end))))
#+END_SRC

* Org agenda setup
#+BEGIN_SRC emacs-lisp
(defun circ/setup-agenda-view()
  (interactive)
  (circ/open-org-inbox-file)
  (circ/tab-line-close-other-tabs)
  (split-window-right)
  (circ/org-agenda-tasks)
  (circ/tab-line-close-other-tabs)
  (split-window-right)
  (circ/org-agenda-agenda)
  (circ/tab-line-close-other-tabs)
  (balance-windows)
  (windmove-right)
  (circ/org-agenda-redo)
  (windmove-left)
  (circ/org-agenda-redo)
  (tab-bar-rename-tab "PIMS"))
#+END_SRC

#+begin_src emacs-lisp
(defun circ/org-agenda-agenda ()
  (interactive)
  (org-agenda nil "A"))

(defun circ/org-agenda-tasks ()
  (interactive)
  (org-agenda nil "T"))
#+end_src

* org agenda toggle blocked tasks
#+BEGIN_SRC emacs-lisp
(defun circ/org-agenda-toggle-blocked-tasks ()
  (interactive)
  (cond ((eq org-agenda-dim-blocked-tasks 'invisible)
         (setq org-agenda-dim-blocked-tasks t))
        (org-agenda-dim-blocked-tasks
         (setq org-agenda-dim-blocked-tasks 'invisible)))
  (org-agenda-redo))
#+END_SRC
* org agenda toggle clock closed
#+BEGIN_SRC emacs-lisp
(defun circ/org-agenda-toggle-clock-closed ()
  (interactive)
  (cond ((equal org-agenda-log-mode-items '(clock))
         (setq org-agenda-log-mode-items '(closed)))
        (t
         (setq org-agenda-log-mode-items '(clock))))
  (org-agenda-redo))
#+END_SRC
* org agenda toggle hide tags
#+BEGIN_SRC emacs-lisp
(defun circ/org-agenda-toggle-hide-tags ()
  (interactive)
  (if org-agenda-hide-tags-regexp
      (setq org-agenda-hide-tags-regexp nil)
    (setq org-agenda-hide-tags-regexp ".*"))
  (org-agenda-redo))
#+END_SRC
* Org toggle pinned
#+begin_src emacs-lisp
(defun circ/org-toggle-pinned-property ()
  (interactive)
  (save-excursion
    (org-back-to-heading)
    (if (org-entry-get nil "Pinned")
        (progn
          (org-delete-property "Pinned")
          (org-toggle-tag "PINNED" 'off)
          (message "Entry unpinned"))
      (progn
        (org-entry-put nil "Pinned" "t")
        (org-toggle-tag "PINNED" 'on)
        (message "Entry pinned")))))

;; Code taken from `org-agenda-set-propert' which navigates to the headline and
;; calls some function.
(defun circ/org-agenda-toggle-pinned-property ()
  "Toggles the pin property on the current headline."
  (interactive)
  (org-agenda-check-no-diary)
  (org-agenda-maybe-loop
   #'org-agenda-set-property nil nil nil
   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
                        (org-agenda-error)))
          (buffer (marker-buffer hdmarker))
          (pos (marker-position hdmarker))
          (inhibit-read-only t)
          newhead)
     (org-with-remote-undo buffer
       (with-current-buffer buffer
         (widen)
         (goto-char pos)
         (org-show-context 'agenda)
         (circ/org-toggle-pinned-property))))))
#+end_src
* Set tag face
#+begin_src emacs-lisp
(set-face-attribute 'org-tag nil
		    :foreground "magenta1")
#+end_src
