elisp/org-bullets.el

   1 ;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
   2 ;;; Version: 0.2.4
   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 symbols, which will be repeated."
  50   :group 'org-bullets
  51   :type '(repeat (string :tag "Bullet character")))
  52
  53 (defcustom org-bullets-face-name nil
  54   "This variable allows the org-mode bullets face to be
  55  overridden. If set to a name of a face, that face will be
  56  used. Otherwise the face of the heading level will be used."
  57   :group 'org-bullets
  58   :type 'symbol)
  59
  60 (defvar org-bullets-bullet-map
  61   '(keymap
  62     (mouse-1 . org-cycle)
  63     (mouse-2
  64      . (lambda (e)
  65          (interactive "e")
  66          (mouse-set-point e)
  67          (org-cycle))))
  68   "Mouse events for bullets.
  69 Should this be undesirable, one can remove them with
  70
  71 \(setcdr org-bullets-bullet-map nil\)")
  72
  73 (defun org-bullets-level-char (level)
  74   (string-to-char
  75    (nth (mod (1- level)
  76              (length org-bullets-bullet-list))
  77         org-bullets-bullet-list)))
  78
  79 ;;;###autoload
  80 (define-minor-mode org-bullets-mode
  81     "UTF8 Bullets for org-mode"
  82   nil nil nil
  83   (let* (( keyword
  84            `(("^\\*+ "
  85               (0 (let* (( level (- (match-end 0) (match-beginning 0) 1))
  86                         ( is-inline-task
  87                           (and (boundp 'org-inlinetask-min-level)
  88                                (>= level org-inlinetask-min-level))))
  89                    (compose-region (- (match-end 0) 2)
  90                                    (- (match-end 0) 1)
  91                                    (org-bullets-level-char level))
  92                    (when is-inline-task
  93                      (compose-region (- (match-end 0) 3)
  94                                      (- (match-end 0) 2)
  95                                      (org-bullets-level-char level)))
  96                    (when (facep org-bullets-face-name)
  97                      (put-text-property (- (match-end 0)
  98                                            (if is-inline-task 3 2))
  99                                         (- (match-end 0) 1)
 100                                         'face
 101                                         org-bullets-face-name))
 102                    (put-text-property (match-beginning 0)
 103                                       (- (match-end 0) 2)
 104                                       'face (list :foreground
 105                                                   (face-attribute
 106                                                    'default :background)))
 107                    (put-text-property (match-beginning 0)
 108                                       (match-end 0)
 109                                       'keymap
 110                                       org-bullets-bullet-map)
 111                    nil))))))
 112     (if org-bullets-mode
 113         (progn
 114           (font-lock-add-keywords nil keyword)
 115           (font-lock-fontify-buffer))
 116       (save-excursion
 117         (goto-char (point-min))
 118         (font-lock-remove-keywords nil keyword)
 119         (while (re-search-forward "^\\*+ " nil t)
 120           (decompose-region (match-beginning 0) (match-end 0)))
 121         (font-lock-fontify-buffer))
 122       )))
 123
 124 (provide 'org-bullets)
 125
 126 ;;; org-bullets.el ends here