Org-mode Source Block Visibility Cycling

Question

I'm trying to add source blocks to the visibility cycling tree. Essentially I want a source block to be treated as a child of its heading. Consider the following org-mode document:

* Heading 1
** Heading 2
#+BEGIN_SRC R
print("hello world")
#+END_SRC
** Heading 3

I would like to be able to press TAB on heading one to cycle through the folding of the various parts including the source block. Currently org-mode does seem to have the facilities for folding the source block, because I can fold that if I go to #+BEGIN_SRC R and hit tab, but it doesnt seem to be being treated in the global cycling. Any suggestions to add it?

Thanks!

Answer 1

This is a slight modification of the code contained in the link mentioned in my first comment above: https://stackoverflow.com/a/21594242/2112489

All I did was replace the begin / end html regexp for the SRC regexp. Go ahead and give it a whirl and see if it is what you're looking for. I left my prior footnote modification in there.

(require 'org)

(defalias 'org-cycle-hide-drawers 'lawlist-block-org-cycle-hide-drawers)

(defun lawlist-block-org-cycle-hide-drawers (state)
  "Re-hide all drawers, footnotes or html blocks after a visibility state change."
  (when
    (and
      (derived-mode-p 'org-mode)
      (not (memq state '(overview folded contents))))
    (save-excursion
      (let* (
          (globalp (memq state '(contents all)))
          (beg (if globalp (point-min) (point)))
          (end
            (cond
              (globalp
                (point-max))
              ((eq state 'children)
                (save-excursion (outline-next-heading) (point)))
              (t (org-end-of-subtree t)) )))
        (goto-char beg)
        (while
          (re-search-forward
            ".*\\[fn\\|^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$" end t)
          (lawlist-org-flag t))))))

(defalias 'org-cycle-internal-local 'lawlist-block-org-cycle-internal-local)

(defun lawlist-block-org-cycle-internal-local ()
  "Do the local cycling action."
  (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
    (save-excursion
      (if (org-at-item-p)
        (progn
          (beginning-of-line)
          (setq struct (org-list-struct))
          (setq eoh (point-at-eol))
          (setq eos (org-list-get-item-end-before-blank (point) struct))
          (setq has-children (org-list-has-child-p (point) struct)))
        (org-back-to-heading)
        (setq eoh (save-excursion (outline-end-of-heading) (point)))
        (setq eos (save-excursion (1- (org-end-of-subtree t t))))
        (setq has-children
          (or
            (save-excursion
              (let ((level (funcall outline-level)))
                (outline-next-heading)
                (and
                  (org-at-heading-p t)
                  (> (funcall outline-level) level))))
            (save-excursion
              (org-list-search-forward (org-item-beginning-re) eos t)))))
      (beginning-of-line 2)
      (if (featurep 'xemacs)
        (while
            (and
              (not (eobp))
              (get-char-property (1- (point)) 'invisible))
          (beginning-of-line 2))
        (while
            (and
              (not (eobp))
              (get-char-property (1- (point)) 'invisible))
          (goto-char (next-single-char-property-change (point) 'invisible))
          (and
            (eolp)
            (beginning-of-line 2))))
      (setq eol (point)))
    (cond
      ((= eos eoh)
        (unless (org-before-first-heading-p)
          (run-hook-with-args 'org-pre-cycle-hook 'empty))
        (org-unlogged-message "EMPTY ENTRY")
        (setq org-cycle-subtree-status nil)
        (save-excursion
          (goto-char eos)
          (outline-next-heading)
          (if (outline-invisible-p)
            (org-flag-heading nil))))
      ((and
          (or
            (>= eol eos)
            (not (string-match "\\S-" (buffer-substring eol eos))))
          (or
            has-children
            (not (setq children-skipped
              org-cycle-skip-children-state-if-no-children))))
        (unless (org-before-first-heading-p)
          (run-hook-with-args 'org-pre-cycle-hook 'children))
        (if (org-at-item-p)
          ;; then
          (org-list-set-item-visibility (point-at-bol) struct 'children)
          ;; else
          (org-show-entry)
          (org-with-limited-levels (show-children))
          (when (eq org-cycle-include-plain-lists 'integrate)
            (save-excursion
              (org-back-to-heading)
              (while (org-list-search-forward (org-item-beginning-re) eos t)
                (beginning-of-line 1)
                (let* (
                    (struct (org-list-struct))
                    (prevs (org-list-prevs-alist struct))
                    (end (org-list-get-bottom-point struct)))
                  (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
                    (org-list-get-all-items (point) struct prevs))
                  (goto-char (if (< end eos) end eos)))))))
        (org-unlogged-message "CHILDREN")
        (save-excursion
          (goto-char eos)
          (outline-next-heading)
          (if (outline-invisible-p)
            (org-flag-heading nil)))
        (setq org-cycle-subtree-status 'children)
        (unless (org-before-first-heading-p)
          (run-hook-with-args 'org-cycle-hook 'children)))
      ((or
          children-skipped
          (and
            (eq last-command this-command)
            (eq org-cycle-subtree-status 'children)))
        (unless (org-before-first-heading-p)
          (run-hook-with-args 'org-pre-cycle-hook 'subtree))
        (outline-flag-region eoh eos nil)
        (org-unlogged-message
        (if children-skipped
          "SUBTREE (NO CHILDREN)"
          "SUBTREE"))
        (setq org-cycle-subtree-status 'subtree)
        (unless (org-before-first-heading-p)
          (run-hook-with-args 'org-cycle-hook 'subtree)))
      ((eq org-cycle-subtree-status 'subtree)
        (org-show-subtree)
        (message "ALL")
        (setq org-cycle-subtree-status 'all))
      (t
        (run-hook-with-args 'org-pre-cycle-hook 'folded)
        (outline-flag-region eoh eos t)
        (org-unlogged-message "FOLDED")
        (setq org-cycle-subtree-status 'folded)
        (unless (org-before-first-heading-p)
        (run-hook-with-args 'org-cycle-hook 'folded))))))

(defun lawlist-org-flag (flag)
  "When FLAG is non-nil, hide any of the following:  html code block;
footnote; or, the properties drawer.  Otherwise make it visible."
  (save-excursion
    (beginning-of-line 1)
    (cond
      ((looking-at ".*\\[fn")
        (let* (
          (begin (match-end 0))
          end-footnote)
          (if (re-search-forward "\\]"
                (save-excursion (outline-next-heading) (point)) t)
            (progn
              (setq end-footnote (point))
              (outline-flag-region begin end-footnote flag))
            (user-error "Error beginning at point %s." begin))))
      ((looking-at "^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$")
        (let* ((begin (match-end 0)))
          (if (re-search-forward "^\\#\\+END_SRC.*$\\|^[ \t]*:END:"
                (save-excursion (outline-next-heading) (point)) t)
            (outline-flag-region begin (point-at-eol) flag)
            (user-error "Error beginning at point %s." begin)))))))

(defun lawlist-toggle-block-visibility ()
"For this function to work, the cursor must be on the same line as the regexp."
(interactive)
  (if
      (save-excursion
        (beginning-of-line 1)
          (looking-at
            ".*\\[fn\\|^\\#\\+BEGIN_SRC.*$\\|^[ \t]*:PROPERTIES:[ \t]*$"))
    (lawlist-org-flag (not (get-char-property (match-end 0) 'invisible)))
    (message "Sorry, you are not on a line containing the beginning regexp.")))