From e74df86f3eba9aa9d24597dc7911f67d11ecf877 Mon Sep 17 00:00:00 2001
From: rekado <rekado@elephly.net>
Date: Fri, 8 Jul 2016 20:52:10 +0200
Subject: Prettify org source blocks.

---
 init.org | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 79 insertions(+), 1 deletion(-)

diff --git a/init.org b/init.org
index 65c3f72..d0048fa 100644
--- a/init.org
+++ b/init.org
@@ -231,7 +231,85 @@ This is my org mode configuration.  Document it.
   (find-file (concat org-directory "/master.org")))
 #+END_SRC
 
-And here’s how to load it lazily:
+The following snippet is an attempt to prettify the somewhat ugly
+headers of source code blocks in =org-mode=.  The snippet was taken
+from [[https://pank.eu/blog/pretty-babel-src-blocks.html][the blog of Rasmus Pank]] and slightly modified to suit my needs.
+
+#+BEGIN_SRC elisp :noweb-ref org-mode-pretty
+(defvar-local rasmus/org-at-src-begin -1
+  "Variable that holds whether last position was a ")
+
+(defvar rasmus/ob-header-symbol ?☰
+  "Symbol used for babel headers")
+
+(defun rasmus/org-prettify-src--update ()
+  (let ((case-fold-search t)
+        (re "^[ \t]*#\\+begin_src[ \t]+[^ \f\t\n\r\v]+[ \t]*")
+        found)
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward re nil t)
+        (goto-char (match-end 0))
+        (let ((args (org-trim
+                     (buffer-substring-no-properties (point)
+                                                     (line-end-position)))))
+          (when (org-string-nw-p args)
+            (let ((new-cell (cons args rasmus/ob-header-symbol)))
+              (cl-pushnew new-cell prettify-symbols-alist :test #'equal)
+              (cl-pushnew new-cell found :test #'equal)))))
+      (setq prettify-symbols-alist
+            (cl-set-difference prettify-symbols-alist
+                               (cl-set-difference
+                                (cl-remove-if-not
+                                 (lambda (elm)
+                                   (eq (cdr elm) rasmus/ob-header-symbol))
+                                 prettify-symbols-alist)
+                                found :test #'equal)))
+      ;; Clean up old font-lock-keywords.
+      (font-lock-remove-keywords nil prettify-symbols--keywords)
+      (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
+      (font-lock-add-keywords nil prettify-symbols--keywords)
+      (while (re-search-forward re nil t)
+        (font-lock-flush (line-beginning-position) (line-end-position))))))
+
+(defun rasmus/org-prettify-src ()
+  "Hide src options via `prettify-symbols-mode'.
+
+`prettify-symbols-mode' is used because it has uncollpasing. It's
+may not be efficient."
+  (let* ((case-fold-search t)
+         (at-src-block (save-excursion
+                         (beginning-of-line)
+                         (looking-at "^[ \t]*#\\+begin_src[ \t]+[^ \f\t\n\r\v]+[ \t]*"))))
+    ;; Test if we moved out of a block.
+    (when (or (and rasmus/org-at-src-begin
+                   (not at-src-block))
+              ;; File was just opened.
+              (eq rasmus/org-at-src-begin -1))
+      (rasmus/org-prettify-src--update))
+    ;; Remove composition if at line; doesn't work properly.
+    ;; (when at-src-block
+    ;;   (with-silent-modifications
+    ;;     (remove-text-properties (match-end 0)
+    ;;                             (1+ (line-end-position))
+    ;;                             '(composition))))
+    (setq rasmus/org-at-src-begin at-src-block)))
+
+(defun rasmus/org-prettify-symbols ()
+  (mapc (apply-partially 'add-to-list 'prettify-symbols-alist)
+        (cl-reduce 'append
+                   (mapcar (lambda (x) (list x (cons (upcase (car x)) (cdr x))))
+                           `(("#+begin_src" . ?✎) ;; ➤ 🖝 ➟ ➤ ✎
+                             ("#+end_src"   . ?□) ;; ⏹
+                             ("#+header:" . ,rasmus/ob-header-symbol)
+                             ("#+begin_quote" . ?»)
+                             ("#+end_quote" . ?«)))))
+  (turn-on-prettify-symbols-mode)
+  (add-hook 'post-command-hook 'rasmus/org-prettify-src t t))
+(add-hook 'org-mode-hook #'rasmus/org-prettify-symbols)
+#+END_SRC
+
+All of this should be loaded lazily.
 
 #+BEGIN_SRC elisp :noweb-ref org-mode
 (provide 'my/init-org)
-- 
cgit v1.2.3