code/elisp/worg-fortune.el

   1 ;;; worg-fortune.el --- export Worg quotes into fortune file
   2 ;;
   3 ;; Copyright (C) 2011 Bastien Guerry, Inc.
   4 ;;
   5 ;; Author: Bastien Guerry <bzg AT gnu DOT org>
   6 ;; Maintainer: Bastien Guerry <bzg AT gnu DOT org>
   7 ;; Keywords: org, worg, quote, fortune
   8 ;; Description: export Worg quotes into fortune file
   9
  10 ;; This file is NOT part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Example: Fortunes limited to 120 characters:
  28 ;;
  29 ;; (worg-write-fortune-file "~/install/git/worg/org-quotes.org"
  30 ;;                          "/srv/http/org-mode/fortunes" 120)
  31 ;;
  32 ;; This is the function that is used to create the javascript
  33 ;; code on http://orgmode.org that inserts a random quote:
  34 ;;
  35 ;; (worg-write-fortune-file
  36 ;;  "~/install/git/worg/org-quotes.org"
  37 ;;  "/srv/http/org-mode/org-quote.js"
  38 ;;  130
  39 ;;  "r_text[%d] = \"%s\";" "\n"
  40 ;;  'worg-fortune-insert-javascript-pre
  41 ;;  'worg-fortune-insert-javascript-post)
  42 ;;
  43 ;;; Code:
  44
  45 ;; List where to store the fortune strings
  46 (defvar worg-fortune nil)
  47
  48 ;; Counter that can also be used in preamble or postamble
  49 (defvar worg-fortune-cnt 0)
  50
  51 (defun worg-write-fortune-file (src dest limit &optional fmt sep pre post)
  52   "Collect fortunes from SRC file and write them to DEST file.
  53 LIMIT is the maximum size of a fortune to be added.
  54
  55 Optional fourth argument FMT is a format to apply to the inserted
  56 quote, and optional fifth argument SEP is the separator to use.
  57 For now, the format should contain both %d and %s format strings,
  58 in this order.
  59
  60 PRE and POST are a preambule and a postamble to the fortune file.
  61 They can be either a string or a function which will be applied
  62 in the DEST buffer."
  63   (save-window-excursion
  64     (find-file src)
  65     (setq worg-fortune nil worg-fortune-cnt 0)
  66     (worg-collect-fortune-from-buffer)
  67     (find-file dest)
  68     (erase-buffer)
  69     ;; Insert preamble
  70     (cond ((functionp pre) (funcall pre))
  71           ((stringp pre) (insert pre)))
  72     ;; insert fortune strings
  73     (let (f)
  74       (while (setq f (pop worg-fortune))
  75         (when (< (length f) limit)
  76           (insert (if fmt (format fmt worg-fortune-cnt f) f))
  77           (insert (or sep "\n%\n"))
  78           (setq worg-fortune-cnt (1+ worg-fortune-cnt)))))
  79     ;; Insert postamble
  80     (cond ((functionp post) (funcall post))
  81           ((stringp post) (insert post)))
  82     (write-file dest)))
  83
  84 (defun worg-collect-fortune-from-buffer nil
  85   "Collect a buffer's fortunes into `worg-fortune'."
  86   (interactive)
  87   ;; Make sure we are in org-mode
  88   (org-mode)
  89   (setq worg-fortune nil)
  90   (goto-char (point-min))
  91   (while (re-search-forward "^#\\+begin_quote.*$" nil t)
  92     (let* ((start (1+ (match-end 0)))
  93            (end (progn (re-search-forward "^#\\+end_quote.*$" nil t)
  94                        (1- (match-beginning 0))))
  95            (f (buffer-substring-no-properties start end)))
  96       (setq f (worg-fortune-cleanup f))
  97       (add-to-list 'worg-fortune f t))))
  98
  99 (defun worg-fortune-cleanup (fortune)
 100   "Clean up HTML and Org elements in FORTUNE."
 101   (setq fortune (replace-regexp-in-string "@<[^>]+>" "" fortune)
 102         fortune (replace-regexp-in-string "\\\\" "" fortune))
 103   (with-temp-buffer
 104     (insert fortune)
 105     (goto-char (point-min))
 106     (while (re-search-forward org-bracket-link-analytic-regexp nil t)
 107       (replace-match (match-string 5)))
 108     (goto-char (point-max))
 109     (beginning-of-line)
 110     (when (looking-at "^ +")
 111       (replace-match ""))
 112     (insert " -- ")
 113     (goto-char (point-min))
 114     (while (re-search-forward "\n" nil t)
 115       (replace-match " "))
 116     (setq fortune (buffer-string))))
 117
 118 (defun worg-fortune-insert-javascript-pre ()
 119   (goto-char (point-min))
 120   (insert "var r_text = new Array ();\n"))
 121
 122 (defun worg-fortune-insert-javascript-post ()
 123   (goto-char (point-max))
 124   (insert (format "var i = Math.floor(%d*Math.random())\n"
 125                   worg-fortune-cnt)
 126           "document.write(r_text[i]);"))
 127
 128 (provide 'worg-fortune)
 129