[Top][All Lists]

[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)
        ;; 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.
          (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)
        (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 
    (let* ((templates (map 'list 'second org-structure-template-alist))
           (prefixes (map 'list (lambda (tp)
                                  ;; Get template and pre-whitespace prefix for 
                                  (reverse (s-match (rx (group
                                                         (1+ (not (any "\n" 
                                                        (1+ anything))
           (prefix (completing-read "Template: " prefixes nil t))
           (template (second (assoc prefix prefixes))))

  (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."
      (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 ()
    (when (ap/org-in-block-p)
      (insert (replace-regexp-in-string
               " +" " " (delete-and-extract-region (point-min) (point-max))))

  (defun ap/org-insert-structure-template-or-enclose-region ()
    "Insert structure block template.  When region is active, enclose region in 
    (require 's)
    (let* ((template (ap/org-read-structure-template))
           (text "")
      (when (use-region-p)
        (setq text (buffer-substring-no-properties (region-beginning) 
        (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."
    (if (use-region-p)
          (goto-char (region-beginning))
          (while (re-search-forward  "^ *#\\+BEGIN_" (region-end) nil)

  (defun ap/org-change-block-type-at-point ()
    "Change type of org-mode block at point."
    (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))
      ;; 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" 
      ;; 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 ()
    (if (or (use-region-p) (looking-back "^"))
      (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)
    (when mod (insert mod) (forward-line))
    (when text (insert text))))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]