McPhee mode: Org-mode refiling system using hydras

README.md

McPhee mode: Org-mode refiling system using hydras

A tool for quickly filing selections, lines, and blocks into headings within the same file (which allows easy undo). See https://jsomers.net/blog/the-mcphee-method.

To use, open a file that has been converted to org-mode. Then create the headings you want to refile into. Put the keyboard shortcut for each heading within the heading itself, like so:

* Buckets
** [gd] Section 1
** [2] Section 2
** [3] Section 3
** [v] Section 4

With point over the * Buckets line, type C-c R. That will define the new refile targets.

Then, to begin refiling, C-c r. Now you will get a hydra with the expected keybindings. Merely pressing 2 will refile whatever is in your selection to the "Section 2" heading. If you're within a code block, the refile command will refile the whole block.

Acknowledgements:

• Fast refiling in org-mode with hydras, Josh Moller-Mara
• Splitting an Org block into two, A Scripter's Notes

refile.el

(setq org-refile-use-cache nil)

(defvar org-refile-region-format "\n\n%s\n\n")

(defvar org-refile-region-position 'bottom
  "Where to refile a region. Use 'bottom to refile at the
end of the subtree. ")

(defun org-refile-region (beg end target)
  "Refile the active region.
If no region is active, refile the current block."
  (interactive "r\nP")
  ;; mark block if no region is set
  (unless (use-region-p)
    (setq beg (save-excursion
                (spacemacs/select-current-block)
                (skip-chars-forward "\n\t ")
                (region-beginning))
          end (save-excursion
                (spacemacs/select-current-block)
                (region-end))))
  (add-text-properties beg end '(font-lock-face font-lock-warning-face))
  (let* ((target (if target target (save-excursion (org-refile-get-location))))
         (file (nth 1 target))
         (pos (nth 3 target))
         (backlink (format " [[%s::%d][{src}]]" buffer-file-name (line-number-at-pos)))
         (text (concat (buffer-substring-no-properties beg end) backlink)))
    (deactivate-mark)
    (with-current-buffer (find-file-noselect file)
      (save-excursion
        (goto-char pos)
        (if (eql org-refile-region-position 'bottom)
            (org-end-of-subtree)
          (org-end-of-meta-data))
        (insert (format org-refile-region-format text))))))

(defun my/refile (file headline &optional beg end)
  (if (use-region-p)
    (setq beg (region-beginning)
          end (region-end)))
  (let ((pos (save-excursion
               (find-file file)
               (org-find-exact-headline-in-buffer headline))))
    (org-refile-region beg end (list headline file nil pos))
    )
  (switch-to-buffer (current-buffer))
  (message "Refiled to `%s'" headline)
  )

(defun jsomers/make-org-refile-hydra (file keyandheadline)
  "Make a hydra named HYDRANAME with refile targets to FILE.
  KEYANDHEADLINE should be a list of cons cells of the form (\"key\" . \"headline\")"
  (eval
   `(defhydra my/org-refile-hydra (:foreign-keys run)
      "Refile"
      ,@(cl-loop for kv in keyandheadline
                 collect (list (car kv) (list 'my/refile file (cdr kv)) (replace-regexp-in-string "\\[[a-zA-Z0-9]+\\] " "" (cdr kv))))
      ("q" nil "cancel"))))

(defun jsomers/heading-to-cons-list (heading)
  (let* ((fstpart (car (split-string heading)))
         (key (replace-regexp-in-string "\\[" "" (replace-regexp-in-string "\\]" "" fstpart)))
         )
         (cons key heading))
  )

(defun jsomers/make-buckets-hydra ()
  (interactive)
  (let* ((headings (cdr (org-map-entries '(lambda () (nth 4 (org-heading-components))) nil 'tree)))
         (x (mapcar 'jsomers/heading-to-cons-list headings))
         )
    (jsomers/make-org-refile-hydra buffer-file-name x)
    )
  (message "Set new refile bindings")
  )

(global-set-key (kbd "C-c r") 'my/org-refile-hydra/body)
(global-set-key (kbd "C-c R") 'jsomers/make-buckets-hydra)

    (defun modi/org-in-any-block-p ()
      "Return non-nil if the point is in any Org block.
The Org block can be *any*: src, example, verse, etc., even any
Org Special block.
This function is heavily adapted from `org-between-regexps-p'."
      (save-match-data
        (let ((pos (point))
              (case-fold-search t)
              (block-begin-re "^[[:blank:]]*#\\+begin_\\(?1:.+?\\)\\(?: .*\\)*$")
              (limit-up (save-excursion (outline-previous-heading)))
              (limit-down (save-excursion (outline-next-heading)))
              beg end)
          (save-excursion
            ;; Point is on a block when on BLOCK-BEGIN-RE or if
            ;; BLOCK-BEGIN-RE can be found before it...
            (and (or (org-in-regexp block-begin-re)
                     (re-search-backward block-begin-re limit-up :noerror))
                 (setq beg (match-beginning 0))
                 ;; ... and BLOCK-END-RE after it...
                 (let ((block-end-re (concat "^[[:blank:]]*#\\+end_"
                                             (match-string-no-properties 1)
                                             "\\( .*\\)*$")))
                   (goto-char (match-end 0))
                   (re-search-forward block-end-re limit-down :noerror))
                 (> (setq end (match-end 0)) pos)
                 ;; ... without another BLOCK-BEGIN-RE in-between.
                 (goto-char (match-beginning 0))
                 (not (re-search-backward block-begin-re (1+ beg) :noerror))
                 ;; Return value.
                 (cons beg end))))))

    (defun modi/org-split-block ()
      "Sensibly split the current Org block at point.
(1) Point in-between a line
    #+begin_src emacs-lisp             #+begin_src emacs-lisp
    (message▮ \"one\")                   (message \"one\")
    (message \"two\")          -->       #+end_src
    #+end_src                          ▮
                                       #+begin_src emacs-lisp
                                       (message \"two\")
                                       #+end_src
(2) Point at EOL
    #+begin_src emacs-lisp             #+begin_src emacs-lisp
    (message \"one\")▮                   (message \"one\")
    (message \"two\")          -->       #+end_src
    #+end_src                          ▮
                                       #+begin_src emacs-lisp
                                       (message \"two\")
                                       #+end_src
(3) Point at BOL
    #+begin_src emacs-lisp             #+begin_src emacs-lisp
    (message \"one\")                    (message \"one\")
    ▮(message \"two\")          -->      #+end_src
    #+end_src                          ▮
                                       #+begin_src emacs-lisp
                                       (message \"two\")
                                       #+end_src
"
      (interactive)
      (if (modi/org-in-any-block-p)
          (save-match-data
            (save-restriction
              (widen)
              (let ((case-fold-search t)
                    (at-bol (bolp))
                    block-start
                    block-end)
                (save-excursion
                  (re-search-backward "^\\(?1:[[:blank:]]*#\\+begin_.+?\\)\\(?: .*\\)*$" nil nil 1)
                  (setq block-start (match-string-no-properties 0))
                  (setq block-end (replace-regexp-in-string
                                   "begin_" "end_" ;Replaces "begin_" with "end_", "BEGIN_" with "END_"
                                   (match-string-no-properties 1))))
                ;; Go to the end of current line, if not at the BOL
                ;;(unless at-bol
                ;;  (end-of-line 1))
                ;;(insert (concat (if at-bol "" "\n")
                (insert (concat (if at-bol "" "\n")
                                block-end
                                "\n\n"
                                block-start
                                ;;(if at-bol "\n" "")))
                                (if at-bol "\n" "\n")))
                ;; Go to the line before the inserted "#+begin_ .." line
                (beginning-of-line (if at-bol -1 0)))))
        (message "Point is not in an Org block")))

    (defun modi/org-meta-return (&optional arg)
      "Insert a new heading or wrap a region in a table.
Calls `org-insert-heading', `org-insert-item',
`org-table-wrap-region', or `modi/org-split-block' depending on
context.  When called with an argument, unconditionally call
`org-insert-heading'."
      (interactive "P")
      (org-check-before-invisible-edit 'insert)
      (or (run-hook-with-args-until-success 'org-metareturn-hook)
          (call-interactively (cond (arg #'org-insert-heading)
                                    ((org-at-table-p) #'org-table-wrap-region)
                                    ((org-in-item-p) #'org-insert-item)
                                    ((modi/org-in-any-block-p) #'modi/org-split-block)
                                    (t #'org-insert-heading)))))
    (advice-add 'org-meta-return :override #'modi/org-meta-return)