cgit.sxemacs.org Git - slh/blob - footnote-balloons.el

   1 ;; footnote-balloons.el --- Show footnotes in balloon-help frame   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2012 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   7 ;; Created:    <2012-01-27>
   8 ;; Time-stamp: <Tuesday Mar 25, 2014 10:38:13 steve>
   9 ;; Homepage:   http://www.xemacs.org
  10 ;; Keywords:   mail, news, text, footnote
  11
  12 ;; This file is part of XEmacs.
  13
  14 ;; Redistribution and use in source and binary forms, with or without
  15 ;; modification, are permitted provided that the following conditions
  16 ;; are met:
  17 ;;
  18 ;; 1. Redistributions of source code must retain the above copyright
  19 ;;    notice, this list of conditions and the following disclaimer.
  20 ;;
  21 ;; 2. Redistributions in binary form must reproduce the above copyright
  22 ;;    notice, this list of conditions and the following disclaimer in the
  23 ;;    documentation and/or other materials provided with the distribution.
  24 ;;
  25 ;; 3. Neither the name of the author nor the names of any contributors
  26 ;;    may be used to endorse or promote products derived from this
  27 ;;    software without specific prior written permission.
  28 ;;
  29 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  30 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  31 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  32 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  33 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  34 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  35 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  36 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  37 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  38 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  39 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  40
  41 ;;; Commentary:
  42 ;;
  43 ;;
  44
  45 ;;; Todo:
  46 ;;
  47 ;;
  48
  49 ;;; Code:
  50 (require 'footnote)
  51 (require 'balloon-help)
  52
  53
  54 (defvar footnote-balloon-regexp "\\[[^\]\n]+\\]")
  55
  56 (defun get-foot-string ()
  57   (let (b ext)
  58     (while (looking-at "[ \t]")
  59       (forward-char))
  60     (setq b (point))
  61     ;; Find the end of the footnote.
  62     (re-search-forward (concat "\\\n\\\n\\|\\'\\|"
  63                                footnote-balloon-regexp) nil t)
  64     (beginning-of-line)
  65     (while (looking-at "^")
  66       (backward-char))
  67     (setq ext (make-extent b (point)))
  68     (set-extent-property ext 'footnote t)
  69     (set-extent-face ext 'green)
  70     (extent-string ext)))
  71
  72 (defun footnote-balloons ()
  73   "Turn footnote refs into extents containing the fn string as balloon-help."
  74   (interactive)
  75   (map-extents
  76    #'(lambda (extent ignore)
  77        (when (extent-property extent 'footnote)
  78          (delete-extent extent))))
  79   (save-excursion
  80     (let (ref-beg ref-end ext footnum note)
  81       (goto-char (point-min))
  82       ;; Looking for footnote refs in the text.
  83       (while (re-search-forward footnote-balloon-regexp nil t)
  84         (setq ref-beg (match-beginning 0))
  85         (setq ref-end (match-end 0))
  86         (setq footnum (buffer-substring ref-beg ref-end))
  87         (goto-char (point-max))
  88         ;; Now find the footnote itself.
  89         (when (search-backward footnum ref-end t)
  90           (search-forward footnum nil t)
  91           (setq note (get-foot-string))
  92           (setq ext (make-extent ref-beg ref-end))
  93           (set-extent-face ext 'red)
  94           (set-extent-property ext 'footnote t)
  95           (set-extent-property ext 'highlight t)
  96           (set-extent-property ext 'balloon-help note))
  97         (goto-char ref-end)))))
  98
  99 (provide 'footnote-balloons)
 100 ;;; footnote-balloons.el ends here