Re: Fontification of blocks

From: "Sébastien Vauban" <wxhgmqzgwmuf-geNee64TY+gS+FvcfC7Uqw@public.gmane.org>
To: emacs-orgmode-mXXj517/zsQ@public.gmane.org
Subject: Re: Fontification of blocks
Date: Tue, 01 Feb 2011 22:04:33 +0100	[thread overview]
Message-ID: <80sjw7qxem.fsf@missioncriticalit.com> (raw)
In-Reply-To: 87ei9jkl0l.fsf@gmail.com

Hi Eric, Dan & all,

"Eric Schulte" wrote:
> I think that adding a new block delimiter face which inherits from the
> org-meta face as you've suggested is the way to go.
>
> I would recommend however that rather than removing/changing the
> org-meta-line, quote and verse delimiting faces to cover the entire line you
> simply add the org-block-begin/end-line face overtop of these existing
> faces.  That way the default behavior is not changed by the patch, and users
> have more control over the final display.
>
> In fact rather than having the org-block-begin/end-line faces inherit
> from org-meta-line why not have them begin as empty faces.  Do you think
> this sounds like a good way to go?  If so would you mind submitting a
> patch which
> - doesn't remove existing faces but rather adds these new faces overtop
>   of them
> - includes of definition of the org-block-begin/end-line faces to empty
>   faces (otherwise the elisp compiler will warn of references to
>   undefined variables)
>
> Also, could you share an example code snippet which initializes the
> org-block-begin/end-line faces initialized (either here and/or on worg)?

Here a proposition that goes in that direction -- not yet a real patch, but
something for you to have a look at. Should be easy to test, at least, that's
what I tried to achieve.

#+TITLE:     Patch for block fontification
#+DATE:      2011-02-01
#+LANGUAGE:  en_US

* Abstract

This is the new code that I will supply as a patch. To test it, just
evaluate the next source block, and please report any problem.

What it does:

- add 2 faces for the lines delimiting the beginning and the end of
  the source block

- fixes a tiny bug (affecting the begin delimiter line of source
  blocks) when in "native" fontification (from Dan Davison)

FOR PEOPLE BEING MORE EXPERTS THAN I AM, it shows what I tried for
adding a yellow (very visible, for test purpose) background to the
natively fontified source blocks. This does not work, but is commented
-- so it does not impact anything unless you uncomment it... See line
"NOK".

* Code

#+begin_src emacs-lisp :results silent
(defface org-block-begin-line
  '((t (:inherit org-meta-line
        :underline "light grey" :foreground "#008ED1" :background "#EAEAFF")))
  "Face used for the line delimiting the begin of source blocks.") 

(defface org-block-end-line
  '((t (:inherit org-meta-line
        :overline "light grey" :foreground "#008ED1" :background "#EAEAFF")))
  "Face used for the line delimiting the end of source blocks.") 

(defface org-block-background
  '((t (:background "#FFFF00")))
  "Face used for the source block background.") 

(defun org-fontify-meta-lines-and-blocks (limit)
  "Fontify #+ lines and blocks, in the correct ways."
  (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)
	  (cond
	   ((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
	    ;; a single line of backend-specific content
	    (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 (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))
					; for backend-specific code
	    t)
	   ((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 (match-end 0) end1 (1- (match-beginning 0)))
	      (setq block-end (match-beginning 0))
	      (when quoting
		(remove-text-properties beg end
					'(display t invisible t intangible t)))
	      (add-text-properties
	       beg end
	       '(font-lock-fontified t font-lock-multiline t))
	      (cond
	       ((and lang org-src-fontify-natively)
		(org-src-font-lock-fontify-block lang block-start block-end)
		;; (add-text-properties beg1 (+ end1 1) '(face org-block-background)) ; NOK from svauban: it currently overrides foreground as well!
		)
	       (quoting
		(add-text-properties beg1 (+ end1 1) '(face org-block)))
					; end of source block
	       ((not org-fontify-quote-and-verse-blocks))
	       ((string= block-type "quote")
		(add-text-properties beg1 (1+ end1) '(face org-quote)))
	       ((string= block-type "verse")
		(add-text-properties beg1 (1+ end1) '(face org-verse))))
	      (add-text-properties beg beg1 '(face org-meta-line))
	      (add-text-properties beg beg1 '(face org-block-begin-line)) ; OK from svauban
	      (add-text-properties (1+ end) (1+ end1) '(face org-meta-line))
	      (add-text-properties (1+ end) (1+ end1) '(face org-block-end-line)) ; OK from svauban
	      t))
	   ((member dc1 '("title:" "author:" "email:" "date:"))
	    (add-text-properties
	     beg (match-end 3)
	     (if (member (intern (substring dc1 0 -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) (match-end 6)
	     (if (string-equal dc1 "title:")
		 '(font-lock-fontified t face org-document-title)
	       '(font-lock-fontified t face org-document-info))))
	   ((not (member (char-after beg) '(?\  ?\t)))
	    ;; just any other in-buffer setting, but not indented
	    (add-text-properties
	     beg (1+ (match-end 0))
	     '(font-lock-fontified t face org-meta-line))
	    t)
	   ((or (member dc1 '("begin:" "end:" "caption:" "label:"
			      "orgtbl:" "tblfm:" "tblname:" "result:"
			      "results:" "source:" "srcname:" "call:"))
		(and (match-end 4) (equal dc3 "attr")))
	    (add-text-properties
	     beg (match-end 0)
	     '(font-lock-fontified t face org-meta-line))
	    t)
	   ((member dc3 '(" " ""))
	    (add-text-properties
	     beg (match-end 0)
	     '(font-lock-fontified t face font-lock-comment-face)))
	   (t nil))))))
#+end_src

* Examples

The above Lisp code is already an example of the way faces are
applied. Here is another.

** Don't fontify natively

Execute the following, answering =yes= to the revert buffer question,
if you want to see how it looks like in "standard" fontification.

#+begin_src emacs-lisp :results silent
;; don't fontify code in code blocks
(setq org-src-fontify-natively nil)

(revert-buffer)
(org-shifttab)
#+end_src

** Fontify natively

Execute the following, answering =yes= to the revert buffer question,
for the same in "native" fontification.

#+begin_src emacs-lisp :results silent
;; do fontify code in code blocks
(setq org-src-fontify-natively t)

(revert-buffer)
(org-shifttab)
#+end_src

** Verse

#+begin_verse
Testing the fonctionality.
#+end_verse

** Quote

#+begin_quote
Testing the fonctionality.
#+end_quote

Best regards,
  Seb

-- 
Sébastien Vauban

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode-mXXj517/zsQ@public.gmane.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode