Re: Fontification of blocks

["Sébastien Vauban" <wxhgmqzgwmuf-geNee64TY+gS+FvcfC7Uqw@public.gmane.org>]

Hi Eric(s), Dan & all,

Sébastien Vauban wrote:
> "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.

Eric (Fraga), David (O'Toole) and Carsten, you should love the following...
when in native fontification...

#+TITLE:     Test file for future patch (for block fontification)
#+DATE:      2011-02-02
#+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)

- NEW!! >>> Add a light yellow background in native mode!!! <<< NEW!!

* 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 "#FFFFEA")))
  "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)
                (overlay-put (make-overlay beg1 block-end)
                             'face 'org-block-background)) ; OK from svauban
	       (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.
What do you think?
#+end_verse

** Quote

#+begin_quote
Testing the fonctionality.
What do you think?
#+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