[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [O] function for inserting a block
From: |
Adam Porter |
Subject: |
Re: [O] function for inserting a block |
Date: |
Sat, 02 Sep 2017 21:21:08 -0500 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) |
Hi Eric,
Thanks for doing this. I've had some similar code in my config for a
while. I'll share some of it here in case you find it useful in doing
this. You especially might find the org-read-structure-template
function useful.
Note that some of this uses s and hydra, which obviously isn't suitable
for Org proper, but that could be fixed.
#+BEGIN_SRC elisp
(defun ap/org-copy-block (prefix)
"Copy current \"#+BEGIN_...\" block to the kill-ring."
(interactive "p")
(kill-new (ap/org-block-contents (>= prefix 4))))
(defun ap/org-block-contents (&optional whole)
"Return contents of current \"BEGIN_...\" block.
When WHOLE is non-nil, include enclosing meta lines."
(let ((bounds (ap/org-block-boundaries (not whole))))
(buffer-substring-no-properties (car bounds) (cdr bounds))))
(defun ap/org-block-boundaries (&optional contents)
"Return (BEGINNING . END) of current \"#+BEGIN_...\" block.
If CONTENTS is non-nil, return the boundaries of the block's
contents rather than the entire block."
(let ((case-fold-search t)
(re "#\\+begin_\\(\\sw+\\)")
block-beg block-end contents-beg contents-end)
(save-excursion
;; Get block
(unless (looking-at re)
;; If point is in the middle of the "#+BEGIN...",
;; `search-backward-regexp' fails, so go to end of line first.
(end-of-line)
(condition-case nil
(search-backward-regexp re)
(error "Not in a block.")))
(setq block-beg (point))
(setq block-end (search-forward-regexp (concat (rx bol (optional (1+
space)) "#+end_") (match-string 1))))
(goto-char block-beg)
(forward-line)
(setq contents-beg (point))
(goto-char block-end)
(end-of-line 0)
(setq contents-end (point)))
(if contents
`(,contents-beg . ,contents-end)
`(,block-beg . ,block-end))))
(defun ap/org-read-structure-template ()
"Read org-mode structure template with completion. Returns template
string."
(let* ((templates (map 'list 'second org-structure-template-alist))
(prefixes (map 'list (lambda (tp)
;; Get template and pre-whitespace prefix for
completion
(reverse (s-match (rx (group
(1+ (not (any "\n"
space))))
(1+ anything))
tp)))
templates))
(prefix (completing-read "Template: " prefixes nil t))
(template (second (assoc prefix prefixes))))
template))
(defun ap/org-in-block-p ()
"Non-nil when point belongs to a block.
Return first block name matched, or nil. Beware that in case of
nested blocks, the returned name may not belong to the closest
block from point."
(save-match-data
(let ((case-fold-search t)
(lim-up (save-excursion (outline-previous-heading)))
(lim-down (save-excursion (outline-next-heading))))
(org-between-regexps-p "^[ \t]*#\\+begin_" "^[ \t]*#\\+end_"
lim-up lim-down))))
(defun ap/org-indent-src-block ()
(interactive)
(when (ap/org-in-block-p)
(org-edit-src-code)
(insert (replace-regexp-in-string
" +" " " (delete-and-extract-region (point-min) (point-max))))
(ap/indent-whole-buffer)
(whitespace-cleanup)
(org-edit-src-exit)))
(defun ap/org-insert-structure-template-or-enclose-region ()
"Insert structure block template. When region is active, enclose region in
block."
(require 's)
(interactive)
(let* ((template (ap/org-read-structure-template))
(text "")
enclosed-text)
(when (use-region-p)
(setq text (buffer-substring-no-properties (region-beginning)
(region-end)))
(delete-region (region-beginning) (region-end)))
(setq enclosed-text (s-replace "?" text template))
(insert enclosed-text)
(backward-char (- (length enclosed-text) (length (s-shared-start
enclosed-text template))))))
(defun ap/org-change-block-types ()
"Change the type of org-mode block at point, or blocks in region."
(interactive)
(if (use-region-p)
(progn
(deactivate-mark)
(goto-char (region-beginning))
(while (re-search-forward "^ *#\\+BEGIN_" (region-end) nil)
(ap/org-change-block-type-at-point)))
(ap/org-change-block-type-at-point)))
(defun ap/org-change-block-type-at-point ()
"Change type of org-mode block at point."
(interactive)
(unless (ap/org-in-block-p)
(error "Not in an org-mode block."))
(let* ((template (ap/org-read-structure-template))
(case-fold-search t)
(re "#\\+begin_\\(\\sw+\\)")
(block-bounds (ap/org-block-boundaries))
(block-beg (car block-bounds))
(block-end (cdr block-bounds))
(contents (ap/org-block-contents))
new-block)
;; Insert contents into template
(setq new-block (replace-regexp-in-string (rx "?") contents template))
;; Remove extra newline from e.g. SRC blocks
(setq new-block (replace-regexp-in-string (rx "\n\n#+END") "\n#+END"
new-block))
;; Replace old block with new one
(goto-char block-beg)
(delete-region block-beg block-end)
(insert new-block)
;; Position cursor (especially for SRC blocks, allowing the user to enter
the type)
(search-backward-regexp re)
(search-forward-regexp (rx space))))
;; From https://github.com/abo-abo/hydra/wiki/Org-mode-block-templates
;; With "<" bound to ap/hydra-org-expand-block-template in org-mode-map:
(defhydra hydra-org-block-template (:color blue :hint nil)
"
_c_enter _q_uote _e_macs-lisp _L_aTeX:
_l_atex _E_xample _p_erl _i_ndex:
_a_scii _v_erse _P_erl tangled _I_NCLUDE:
_s_rc ^ ^ plant_u_ml _H_TML:
_h_tml ^ ^ ^ ^ _A_SCII:
"
("s" (ap/org-hydra-expand-template "<s"))
("E" (ap/org-hydra-expand-template "<e"))
("q" (ap/org-hydra-expand-template "<q"))
("v" (ap/org-hydra-expand-template "<v"))
("c" (ap/org-hydra-expand-template "<c"))
("l" (ap/org-hydra-expand-template "<l"))
("h" (ap/org-hydra-expand-template "<h"))
("a" (ap/org-hydra-expand-template "<a"))
("L" (ap/org-hydra-expand-template "<L"))
("i" (ap/org-hydra-expand-template "<i"))
("e" (ap/org-hydra-expand-template "<s" "elisp"))
("p" (ap/org-hydra-expand-template "<s" "perl"))
("u" (ap/org-hydra-expand-template "<s" "plantuml :file CHANGE.png"))
("P" (progn
(insert "#+HEADERS: :results output :exports both :shebang
\"#!/usr/bin/env perl\"\n")
(ap/org-hydra-expand-template "<s" "perl")))
("I" (ap/org-hydra-expand-template "<I"))
("H" (ap/org-hydra-expand-template "<H"))
("A" (ap/org-hydra-expand-template "<A"))
("<" self-insert-command "ins")
("o" nil "quit"))
(defun ap/hydra-org-expand-block-template ()
(interactive)
(if (or (use-region-p) (looking-back "^"))
(hydra-org-block-template/body)
(self-insert-command 1)))
(defun ap/org-hydra-expand-template (str &optional mod)
"Expand org template."
(let (text)
(when (use-region-p)
(setq text (buffer-substring (region-beginning) (region-end)))
(delete-region (region-beginning) (region-end)))
(insert str)
(org-try-structure-completion)
(when mod (insert mod) (forward-line))
(when text (insert text))))
#+END_SRC