contrib/lisp/org-bullets.el

   1 ;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
   2 ;;; Version: 0.1
   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   "Use different background for even and odd lines."
  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 (defvar org-bullet-overlays nil)
  54 (make-variable-buffer-local 'org-bullet-overlays)
  55
  56 (defvar org-bullets-changes nil)
  57 (make-variable-buffer-local 'org-bullets-changes)
  58
  59 (defun org-bullets-match-length ()
  60   (- (match-end 0) (match-beginning 0)))
  61
  62 (defun org-bullets-make-star (bullet-string counter)
  63   (let* ((map '(keymap
  64                 (mouse-1 . org-cycle)
  65                 (mouse-2 . (lambda (e)
  66                              (interactive "e")
  67                              (mouse-set-point e)
  68                              (org-cycle)))))
  69          (face (save-excursion
  70                  (save-match-data
  71                    (beginning-of-line)
  72                    (looking-at "\\*+")
  73                    (intern (concat "org-level-"
  74                                    (int-to-string
  75                                     (1+ (mod (1- (org-bullets-match-length))
  76                                              8))))))))
  77          (overlay (make-overlay (point)
  78                                 (1+ (point)))))
  79     (overlay-put overlay 'display
  80                  (if (zerop counter)
  81                      (propertize bullet-string
  82                                  'face face
  83                                  'local-map map)
  84                      (propertize " "
  85                                  'local-map map)))
  86     (overlay-put overlay 'is-bullet t)
  87     (push overlay org-bullet-overlays)))
  88
  89 (defun org-bullets-clear ()
  90   (mapc 'delete-overlay org-bullet-overlays)
  91   (setq org-bullet-overlays nil))
  92
  93 (defun* org-bullets-redraw (&optional (beginning (point-min)) (end (point-max)))
  94   (save-excursion
  95     (save-match-data
  96       (mapc 'delete-overlay
  97             (remove-if-not
  98              (lambda (overlay) (overlay-get overlay 'is-bullet))
  99              (overlays-in beginning end)))
 100       (goto-char beginning)
 101       (while (and (re-search-forward "^\\*+" nil t)
 102                   (<= (point) end))
 103         (let* ((bullet-string (nth (mod (1- (org-bullets-match-length))
 104                                         (list-length org-bullets-bullet-list))
 105                                    org-bullets-bullet-list)))
 106           (goto-char (match-beginning 0))
 107           (if (save-match-data (looking-at "^\\*+ "))
 108               (let ((counter (1- (org-bullets-match-length))))
 109                 (while (looking-at "[* ]")
 110                   (org-bullets-make-star bullet-string counter)
 111                   (forward-char)
 112                   (decf counter)))
 113               (goto-char (match-end 0)))
 114           )))))
 115
 116 (defun org-bullets-notify-change (&rest args)
 117   (push args org-bullets-changes))
 118
 119 (defun* org-bullets-post-command-hook (&rest ignore)
 120   (unless org-bullets-changes
 121     (return-from org-bullets-post-command-hook))
 122   (let ((min (reduce 'min org-bullets-changes :key 'first))
 123         (max (reduce 'max org-bullets-changes :key 'second)))
 124     (org-bullets-redraw (save-excursion
 125                           (goto-char min)
 126                           (line-beginning-position))
 127                         (save-excursion
 128                           (goto-char max)
 129                           (forward-line)
 130                           (line-end-position))))
 131   (setq org-bullets-changes nil))
 132
 133 ;;; Interface
 134
 135 ;;;###autoload
 136 (define-minor-mode org-bullets-mode
 137     "UTF8 Bullets for org-mode"
 138   nil nil nil
 139   (if org-bullets-mode
 140       (progn
 141         (add-hook 'after-change-functions 'org-bullets-notify-change nil t)
 142         (add-hook 'post-command-hook 'org-bullets-post-command-hook nil t)
 143         (org-bullets-redraw))
 144       (remove-hook 'after-change-functions 'org-bullets-notify-change t)
 145       (remove-hook 'post-command-hook 'org-bullets-post-command-hook t)
 146       (mapc 'delete-overlay org-bullet-overlays)))
 147
 148 (provide 'org-bullets)
 149
 150 ;;; org-bullets.el ends here