org: fontify org-blocks

modules/module-org.el

@@ -2,6 +2,7 @@
 
 (add-hook 'org-load-hook 'narf|org-init t)
 (add-hook 'org-load-hook 'narf|org-keybinds t)
+(add-hook 'org-load-hook 'narf|org-hacks t)
 (add-hook 'org-mode-hook 'narf|org-hook)
 
 (defvar org-directory (expand-file-name "~/Dropbox/docs/"))
@@ -321,5 +322,111 @@
             :e "C-n" 'org-agenda-next-item
             :e "C-p" 'org-agenda-previous-item))))
 
+(defun narf|org-hacks ()
+  (defface org-block-background nil "")
+  (defun org-fontify-meta-lines-and-blocks-1 (limit)
+    "Fontify #+ lines and blocks."
+    (let ((case-fold-search t))
+      (if (re-search-forward
+           "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+           limit t)
+          (let ((beg (match-beginning 0))
+                (block-start (match-end 0))
+                (block-end nil)
+                (lang (match-string 7))
+                (beg1 (line-beginning-position 2))
+                (dc1 (downcase (match-string 2)))
+                (dc3 (downcase (match-string 3)))
+                end end1 quoting block-type ovl)
+            (cond
+             ((and (match-end 4) (equal dc3 "+begin"))
+              ;; Truly a block
+              (setq block-type (downcase (match-string 5))
+                    quoting (member block-type org-protecting-blocks))
+              (when (re-search-forward
+                     (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
+                     nil t)  ;; on purpose, we look further than LIMIT
+                (setq end (min (point-max) (match-end 0))
+                      end1 (min (point-max) (1- (match-beginning 0))))
+                (setq block-end (match-beginning 0))
+                (when quoting
+                  (org-remove-flyspell-overlays-in beg1 end1)
+                  (remove-text-properties beg end
+                                          '(display t invisible t intangible t)))
+                (add-text-properties
+                 beg end '(font-lock-fontified t font-lock-multiline t))
+                (add-text-properties beg beg1 '(face org-meta-line))
+                (org-remove-flyspell-overlays-in beg beg1)
+                (add-text-properties	; For end_src
+                 end1 (min (point-max) (1+ end)) '(face org-meta-line))
+                (org-remove-flyspell-overlays-in end1 end)
+                (cond
+                 ((and lang (not (string= lang "")) org-src-fontify-natively)
+                  (org-src-font-lock-fontify-block lang block-start block-end)
+                  ;;;;;;; EDIT
+                  ;; remove old background overlays
+                  (mapc (lambda (ov)
+                          (if (eq (overlay-get ov 'face) 'org-block-background)
+                              (delete-overlay ov)))
+                        (overlays-at (/ (+ beg1 block-end) 2)))
+                  ;; add a background overlay
+                  (setq ovl (make-overlay beg1 block-end))
+                  (overlay-put ovl 'face 'org-block-background)
+                  (overlay-put ovl 'evaporate t)) ; make it go away when empty
+                 ;; (add-text-properties beg1 block-end '(src-block t)))
+                  ;;;;;;; /EDIT
+                 (quoting
+                  (add-text-properties beg1 (min (point-max) (1+ end1))
+                                       '(face org-block))) ; end of source block
+                 ((not org-fontify-quote-and-verse-blocks))
+                 ((string= block-type "quote")
+                  (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
+                 ((string= block-type "verse")
+                  (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
+                (add-text-properties beg beg1 '(face org-block-begin-line))
+                (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
+                                     '(face org-block-end-line))
+                t))
+             ((string-match-p
+               (format "^\\+%s+:$"
+                       (regexp-opt '("title" "author" "email" "date" "address" "location" "contact"
+                                     "project" "country" "city" "created" "issued" "paid" "currency")))
+               dc1)
+              ;; (member dc1 '("+title:" "+author:" "+email:" "+date:" "+address:" "+location:" "+contact:" "+project:"))
+              (org-remove-flyspell-overlays-in
+               (match-beginning 0)
+               (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
+              (add-text-properties
+               beg (match-end 3)
+               (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
+                   '(font-lock-fontified t invisible t)
+                 '(font-lock-fontified t face org-document-info-keyword)))
+              (add-text-properties
+               (match-beginning 6) (min (point-max) (1+ (match-end 6)))
+               (if (string-equal dc1 "+title:")
+                   '(font-lock-fontified t face org-document-title)
+                 '(font-lock-fontified t face org-document-info))))
+             ((equal dc1 "+caption:")
+              (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
+              (remove-text-properties (match-beginning 0) (match-end 0)
+                                      '(display t invisible t intangible t))
+              (add-text-properties (match-beginning 1) (match-end 3)
+                                   '(font-lock-fontified t face org-meta-line))
+              (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
+                                   '(font-lock-fontified t face org-block))
+              t)
+             ((member dc3 '(" " ""))
+              (org-remove-flyspell-overlays-in beg (match-end 0))
+              (add-text-properties
+               beg (match-end 0)
+               '(font-lock-fontified t face font-lock-comment-face)))
+             (t ;; just any other in-buffer setting, but not indented
+              (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+              (remove-text-properties (match-beginning 0) (match-end 0)
+                                      '(display t invisible t intangible t))
+              (add-text-properties beg (match-end 0)
+                                   '(font-lock-fontified t face org-meta-line))
+              t)))))))
+
 (provide 'module-org)
 ;;; module-org.el ends here

private/themes/narf-dark-theme.el

@@ -308,8 +308,9 @@
    `(org-document-info          ((,c (:foreground ,orange))))
    `(org-document-info-keyword  ((,c (:foreground ,grey-1))))
    `(org-meta-line              ((,c (:foreground ,vsubtle))))
-   `(org-block-begin-line       ((,c (:foreground ,vsubtle))))
+   `(org-block-begin-line       ((,c (:background ,current-line :foreground ,vsubtle))))
    `(org-block-end-line         ((,c (:inherit org-block-begin-line))))
+   `(org-block-background       ((,c (:background ,current-line))))
    `(org-archived               ((,c (:foreground ,grey-.5))))
 
    `(org-document-title   ((,c (:foreground ,cyan))))