diff --git a/contrib/lisp/org-bullets.el b/contrib/lisp/org-bullets.el new file mode 100644 index 000000000..2c4e89b36 --- /dev/null +++ b/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 \ No newline at end of file