From mboxrd@z Thu Jan 1 00:00:00 1970 From: Julien Barnier Subject: [PATCH] Add faces customization to quote and verse blocks Date: Thu, 12 Nov 2009 16:41:38 +0100 Message-ID: <877htv9203.fsf@z.nozav.org> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1N8bwA-0007vA-5k for emacs-orgmode@gnu.org; Thu, 12 Nov 2009 10:50:18 -0500 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1N8bw5-0007tf-OO for emacs-orgmode@gnu.org; Thu, 12 Nov 2009 10:50:17 -0500 Received: from [199.232.76.173] (port=36452 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1N8bw5-0007tc-KW for emacs-orgmode@gnu.org; Thu, 12 Nov 2009 10:50:13 -0500 Received: from lo.gmane.org ([80.91.229.12]:41514) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1N8bw4-0008Tt-PN for emacs-orgmode@gnu.org; Thu, 12 Nov 2009 10:50:13 -0500 Received: from list by lo.gmane.org with local (Exim 4.50) id 1N8bw3-0007T5-Av for emacs-orgmode@gnu.org; Thu, 12 Nov 2009 16:50:11 +0100 Received: from z.nozav.org ([91.121.121.141]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 12 Nov 2009 16:50:11 +0100 Received: from julien by z.nozav.org with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 12 Nov 2009 16:50:11 +0100 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Hi, Here is a small patch that allows to add custom faces to QUOTE and VERSE blocks. As I'm quite new to emacs lisp and as it is the first time I submit a patch to a project, please feel free to correct or reject it if its form or quality is not sufficient. Thanks a lot for all your work on org-mode ! Julien --- lisp/org-faces.el | 28 ++++++++++++++++++++++++++++ lisp/org.el | 15 +++++++++++---- 2 files changed, 39 insertions(+), 4 deletions(-) diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 4543d38..fbac871 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -468,6 +468,34 @@ changes." :group 'org-faces :version "22.1") +(defface org-quote + (org-compatible-face nil + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50" :slant italic)) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70" :slant italic)) + (((class color) (min-colors 8) (background light)) + (:foreground "green" :slant italic)) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow" :slant italic)))) + "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks." + :group 'org-faces + :version "22.1") + +(defface org-verse + (org-compatible-face nil + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50" :slant italic)) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70" :slant italic)) + (((class color) (min-colors 8) (background light)) + (:foreground "green" :slant italic)) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow" :slant italic)))) + "Face for #+BEGIN_VERSE ... #+END_VERSE blocks." + :group 'org-faces + :version "22.1") + (defface org-clock-overlay ;; copied from secondary-selection (org-compatible-face nil '((((class color) (min-colors 88) (background light)) diff --git a/lisp/org.el b/lisp/org.el index 5562d8d..adabfa8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4518,7 +4518,7 @@ will be prompted for." (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) - end end1 quoting) + end end1 quoting block-type quote-block verse-block) (cond ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) ;; a single line of backend-specific content @@ -4532,8 +4532,10 @@ will be prompted for." t) ((and (match-end 4) (equal dc3 "begin")) ;; Truely a block - (setq quoting (member (downcase (match-string 5)) - org-protecting-blocks)) + (setq block-type (downcase (match-string 5)) + quoting (member block-type org-protecting-blocks) + quote-block (equal block-type "quote") + verse-block (equal block-type "verse")) (when (re-search-forward (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") nil t) ;; on purpose, we look further than LIMIT @@ -4546,8 +4548,13 @@ will be prompted for." '(font-lock-fontified t font-lock-multiline t)) (add-text-properties beg beg1 '(face org-meta-line)) (add-text-properties end1 end '(face org-meta-line)) - (when quoting + (cond + (quoting (add-text-properties beg1 end1 '(face org-block))) + (quote-block + (add-text-properties beg1 end1 '(face org-quote))) + (verse-block + (add-text-properties beg1 end1 '(face org-verse)))) t)) ((not (member (char-after beg) '(?\ ?\t))) ;; just any other in-buffer setting, but not indented -- 1.6.5.2