Add km/narrow-to-comment-heading

1 files changed, 55 insertions, 0 deletions

diff --git a/lisp/init-editing.el b/lisp/init-editing.el
index 3d4dd2d..4f2cf80 100644
--- a/lisp/init-editing.el
+++ b/lisp/init-editing.el
@@ -62,6 +62,61 @@
 (define-key replace-map "r" 'query-replace-regexp)
 (define-key replace-map "R" 'replace-regexp)
 
+(defun km/narrow-to-comment-heading ()
+  "Narrow to the current comment heading subtree.
+
+A comment is considered a heading if it is at the beginning of
+the line and if it conists of 3 or more occurences of
+`comment-start'. The number of `comment-start' characters is
+taken to indicate the level of the heading (with 3 being the top
+level).
+
+The buffer will be narrowed from the current comment heading to
+the next comment heading of the same level or, if not found, to
+the end of the buffer.
+
+In the examples below, 'x' indicates the current point and '>>>'
+and '<<<' mark the bounds of the narrowed region.
+
+---------------------------------------------------------------
+    >>>;;; Level one heading
+         x
+
+       ;;;; Level two heading
+
+       <<<
+       ;;; Another level one heading
+------------------------------eob------------------------------
+
+---------------------------------------------------------------
+       ;;; Level one heading
+
+    >>>;;;; Level two heading
+           x
+       <<<
+       ;;;; Another level one heading
+------------------------------eob------------------------------
+
+---------------------------------------------------------------
+    >>>;;; Level one heading
+         x
+
+       ;;;; Level two heading
+       <<<
+------------------------------eob------------------------------"
+  (interactive)
+  (unless comment-start
+    (user-error "Comment syntax is not defined for current buffer"))
+  (unless (= (length comment-start) 1)
+    (user-error "Buffer's comment string consists of more than one character"))
+  (save-excursion
+    (widen)
+    (let ((outline-regexp (concat (s-repeat 4 comment-start) "*")))
+      (outline-mark-subtree)
+      (narrow-to-region (region-beginning) (region-end)))))
+
+(define-key narrow-map "c" 'km/narrow-to-comment-heading)
+
 (defun km/toggle-line-or-region-comment ()
   "Comment/uncomment the current line or region"
     (interactive)