worg-fortune.el 4.3 KB

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