contrib/lisp/org-bullets.el

   1 ;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
   2 ;; Version: 0.2.2
   3 ;; Author: sabof
   4 ;; URL: https://github.com/sabof/org-bullets
   5
   6 ;; This file is NOT part of GNU Emacs.
   7 ;;
   8 ;; This program is free software; you can redistribute it and/or
   9 ;; modify it under the terms of the GNU General Public License as
  10 ;; published by the Free Software Foundation; either version 3, or (at
  11 ;; your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program ; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; The project is hosted at https://github.com/sabof/org-bullets
  26 ;; The latest version, and all the relevant information can be found there.
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'cl))
  31
  32 (defgroup org-bullets nil
  33   "Display bullets as UTF-8 characters."
  34   :group 'org-appearance)
  35
  36 ;; A nice collection of unicode bullets:
  37 ;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters
  38 (defcustom org-bullets-bullet-list
  39   '(;;; Large
  40     "◉"
  41     "○"
  42     "✸"
  43     "✿"
  44     ;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶
  45     ;;; Small
  46     ;; ► • ★ ▸
  47     )
  48   "This variable contains the list of bullets.
  49 It can contain any number of one-character strings.
  50 For levels beyond the size of the list, the stars will be
  51 displayed using the first items again."
  52   :group 'org-bullets
  53   :type '(repeat (string :tag "Bullet character")))
  54
  55 (defcustom org-bullets-face-name nil
  56   "Allows to override `org-mode' bullets face.
  57 If set to a name of a face, that face will be used.
  58 Otherwise the face of the heading level will be used."
  59   :group 'org-bullets
  60   :type 'symbol)
  61
  62 (defvar org-bullets-bullet-map
  63   '(keymap
  64     (mouse-1 . org-cycle)
  65     (mouse-2 . (lambda (e)
  66                  (interactive "e")
  67                  (mouse-set-point e)
  68                  (org-cycle))))
  69   "Mouse events for bullets.
  70 If this is undesirable, one can remove them with
  71
  72 \(setcdr org-bullets-bullet-map nil\)")
  73
  74 (defun org-bullets-level-char (level)
  75   "Return a character corresponding to LEVEL."
  76   (string-to-char
  77    (nth (mod (1- level)
  78              (length org-bullets-bullet-list))
  79         org-bullets-bullet-list)))
  80
  81 ;;;###autoload
  82 (define-minor-mode org-bullets-mode
  83   "UTF-8 bullets for `org-mode'."
  84   nil nil nil
  85   (let* ((keyword
  86           `((,org-outline-regexp-bol
  87              (0 (let (( level (- (match-end 0) (match-beginning 0) 1)))
  88                   (compose-region (- (match-end 0) 2)
  89                                   (- (match-end 0) 1)
  90                                   (org-bullets-level-char level))
  91                   (when (facep org-bullets-face-name)
  92                     (put-text-property (- (match-end 0) 2)
  93                                        (- (match-end 0) 1)
  94                                        'face
  95                                        org-bullets-face-name))
  96                   (put-text-property (match-beginning 0)
  97                                      (- (match-end 0) 2)
  98                                      'face (list :foreground
  99                                                  (face-attribute
 100                                                   'default :background)))
 101                   (put-text-property (match-beginning 0)
 102                                      (match-end 0)
 103                                      'keymap
 104                                      org-bullets-bullet-map)
 105                   nil))))))
 106     (if org-bullets-mode
 107         (progn (font-lock-add-keywords nil keyword)
 108                (font-lock-fontify-buffer))
 109       (save-excursion
 110         (goto-char (point-min))
 111         (font-lock-remove-keywords nil keyword)
 112         (while (re-search-forward org-outline-regexp-bol nil t)
 113           (decompose-region (match-beginning 0) (match-end 0)))
 114         (font-lock-fontify-buffer)))))
 115
 116 (provide 'org-bullets)
 117
 118 ;; Local Variables:
 119 ;; coding: utf-8-emacs
 120 ;; End:
 121
 122 ;;; org-bullets.el ends here