contrib/lisp/org-bullets.el: New file by Evgeni Sabof

Implements a minor mode to show org-mode bullets as UTF-8 characters.

contrib/lisp/org-bullets.el

@@ -0,0 +1,150 @@
+;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
+;;; Version: 0.1
+;;; Author: sabof
+;;; URL: https://github.com/sabof/org-bullets
+
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or (at
+;; your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program ; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The project is hosted at https://github.com/sabof/org-bullets
+;; The latest version, and all the relevant information can be found there.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup org-bullets nil
+  "Use different background for even and odd lines."
+  :group 'org-appearance)
+
+;; A nice collection of unicode bullets:
+;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters
+(defcustom org-bullets-bullet-list
+  '(;;; Large
+    "◉"
+    "○"
+    "✸"
+    "✿"
+    ;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶
+    ;;; Small
+    ;; ► • ★ ▸
+    )
+  "This variable contains the list of bullets.
+It can contain any number of symbols, which will be repeated."
+  :group 'org-bullets
+  :type '(repeat (string :tag "Bullet character")))
+
+(defvar org-bullet-overlays nil)
+(make-variable-buffer-local 'org-bullet-overlays)
+
+(defvar org-bullets-changes nil)
+(make-variable-buffer-local 'org-bullets-changes)
+
+(defun org-bullets-match-length ()
+  (- (match-end 0) (match-beginning 0)))
+
+(defun org-bullets-make-star (bullet-string counter)
+  (let* ((map '(keymap
+                (mouse-1 . org-cycle)
+                (mouse-2 . (lambda (e)
+                             (interactive "e")
+                             (mouse-set-point e)
+                             (org-cycle)))))
+         (face (save-excursion
+                 (save-match-data
+                   (beginning-of-line)
+                   (looking-at "\\*+")
+                   (intern (concat "org-level-"
+                                   (int-to-string
+                                    (1+ (mod (1- (org-bullets-match-length))
+                                             8))))))))
+         (overlay (make-overlay (point)
+                                (1+ (point)))))
+    (overlay-put overlay 'display
+                 (if (zerop counter)
+                     (propertize bullet-string
+                                 'face face
+                                 'local-map map)
+                     (propertize " "
+                                 'local-map map)))
+    (overlay-put overlay 'is-bullet t)
+    (push overlay org-bullet-overlays)))
+
+(defun org-bullets-clear ()
+  (mapc 'delete-overlay org-bullet-overlays)
+  (setq org-bullet-overlays nil))
+
+(defun* org-bullets-redraw (&optional (beginning (point-min)) (end (point-max)))
+  (save-excursion
+    (save-match-data
+      (mapc 'delete-overlay
+            (remove-if-not
+             (lambda (overlay) (overlay-get overlay 'is-bullet))
+             (overlays-in beginning end)))
+      (goto-char beginning)
+      (while (and (re-search-forward "^\\*+" nil t)
+                  (<= (point) end))
+        (let* ((bullet-string (nth (mod (1- (org-bullets-match-length))
+                                        (list-length org-bullets-bullet-list))
+                                   org-bullets-bullet-list)))
+          (goto-char (match-beginning 0))
+          (if (save-match-data (looking-at "^\\*+ "))
+              (let ((counter (1- (org-bullets-match-length))))
+                (while (looking-at "[* ]")
+                  (org-bullets-make-star bullet-string counter)
+                  (forward-char)
+                  (decf counter)))
+              (goto-char (match-end 0)))
+          )))))
+
+(defun org-bullets-notify-change (&rest args)
+  (push args org-bullets-changes))
+
+(defun* org-bullets-post-command-hook (&rest ignore)
+  (unless org-bullets-changes
+    (return-from org-bullets-post-command-hook))
+  (let ((min (reduce 'min org-bullets-changes :key 'first))
+        (max (reduce 'max org-bullets-changes :key 'second)))
+    (org-bullets-redraw (save-excursion
+                          (goto-char min)
+                          (line-beginning-position))
+                        (save-excursion
+                          (goto-char max)
+                          (forward-line)
+                          (line-end-position))))
+  (setq org-bullets-changes nil))
+
+;;; Interface
+
+;;;###autoload
+(define-minor-mode org-bullets-mode
+    "UTF8 Bullets for org-mode"
+  nil nil nil
+  (if org-bullets-mode
+      (progn
+        (add-hook 'after-change-functions 'org-bullets-notify-change nil t)
+        (add-hook 'post-command-hook 'org-bullets-post-command-hook nil t)
+        (org-bullets-redraw))
+      (remove-hook 'after-change-functions 'org-bullets-notify-change t)
+      (remove-hook 'post-command-hook 'org-bullets-post-command-hook t)
+      (mapc 'delete-overlay org-bullet-overlays)))
+
+(provide 'org-bullets)
+
+;;; org-bullets.el ends here