omd.el 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209
  1. ;; omd.el --- org-merge-driver document generator
  2. (defconst omd-bullet-type '("+" "-" "num"))
  3. (defun omd-rand (min max)
  4. "Return random integer in [MIN;MAX[."
  5. (if (< max min)
  6. (rotatef min max))
  7. (let ((d (- max min)))
  8. (+ min (random d))))
  9. (defun omd-random-word (&optional length)
  10. "Return random word."
  11. (unless length
  12. (setq length (omd-rand 2 7)))
  13. (let (chars)
  14. (apply 'string
  15. (dotimes (i length chars)
  16. (push (omd-rand 97 123) chars)))))
  17. (defun omd-random-text (&optional lines length prefix)
  18. "Return random text.
  19. The text has LINES lines and each line is approximately LENGTH
  20. characters."
  21. (unless prefix
  22. (setq prefix ""))
  23. (unless length
  24. (setq length 70))
  25. (unless lines
  26. (setq lines 1))
  27. (let (text)
  28. (dotimes (n lines text)
  29. (if (/= n 0)
  30. (setq text (concat text "\n" prefix)))
  31. (let (line)
  32. (while (< (length line) length)
  33. (let ((w (omd-random-word)))
  34. (setq line (if line (concat line " " w) w))))
  35. (setq text (concat text line))))))
  36. (defun omd-random-paragraph (&optional text)
  37. (unless text
  38. (setq text (omd-random-text (omd-rand 2 5))))
  39. `(paragraph nil ,text))
  40. (defun omd-random-headline (&rest contents)
  41. (let ((title (omd-random-text 1 20)))
  42. `(headline (:title ,title) ,@contents)))
  43. (defun omd-pick-random-element (list)
  44. (let ((len (length list)))
  45. (nth (omd-rand 0 len) list)))
  46. (defun omd-random-list (&optional nitems bullet)
  47. (unless nitems
  48. (setq nitems (omd-rand 2 5)))
  49. (unless bullet
  50. (setq bullet (omd-pick-random-element omd-bullet-type)))
  51. (let* (items)
  52. (dotimes (i nitems)
  53. (push (omd-random-text (omd-rand 2 5) 30) items))
  54. `(list (:bullet ,bullet) ,@items)))
  55. (defun omd-set-contents (elem contents)
  56. (setf (nthcdr 2 elem) contents))
  57. (defun omd-get-contents (elem)
  58. (nthcdr 2 elem))
  59. (defun omd-add-contents (elem &rest contents)
  60. (setcdr (last elem) contents))
  61. (defun omd-get-prop (prop elem)
  62. (plist-get (nth 1 elem) prop))
  63. (defun omd-set-prop (prop val elem)
  64. (setcar (cdr elem) (plist-put (nth 1 elem) prop val)))
  65. (defalias 'omd-copy 'copy-tree)
  66. (defun omd-new-doc (&rest contents)
  67. `(doc () ,@contents))
  68. (defun omd-to-string (elem &optional level)
  69. (unless level
  70. (setq level 1))
  71. (let* ((type (nth 0 elem))
  72. (prop (nth 1 elem))
  73. (cont (nthcdr 2 elem)))
  74. (cond
  75. ((eq 'doc type)
  76. (mapconcat 'omd-to-string cont ""))
  77. ((eq 'headline type)
  78. (apply 'concat
  79. (make-string level ?*)
  80. " "
  81. (omd-get-prop :title elem)
  82. "\n"
  83. (mapcar (lambda (e)
  84. (omd-to-string e (1+ level)))
  85. cont)))
  86. ((eq 'list type)
  87. (let ((n 0)
  88. (bullet (omd-get-prop :bullet elem)))
  89. (apply 'concat
  90. (mapcar (lambda (item)
  91. (incf n)
  92. (let* ((prefix (if (string= "num" bullet)
  93. (format "%d. " n)
  94. (concat bullet " ")))
  95. (space (make-string (length prefix) ?\ ))
  96. (replace (concat "\n" space "\\1")))
  97. (concat
  98. prefix
  99. (replace-regexp-in-string "\n\\(.\\)" replace item)
  100. "\n")))
  101. cont))))
  102. ((eq 'paragraph type)
  103. (apply 'concat cont)))))
  104. (defun omd-write-to-file (elem file)
  105. (with-temp-file file
  106. (insert (omd-to-string string))))
  107. (defun omd-random-insert (elem list)
  108. "Insert ELEM in LIST at a random position."
  109. (let* ((pos (omd-rand 0 (length list))))
  110. (if (= pos 0)
  111. (cons elem list)
  112. (let ((cell (nthcdr (1- pos) list)))
  113. (setcdr cell
  114. (cons elem (cdr cell))))
  115. list)))
  116. (defun omd-mutate-elem-list (elem &optional nb)
  117. "Append NB items at random positions in every list of ELEM."
  118. (unless nb
  119. (setq nb 1))
  120. (let* ((type (nth 0 elem))
  121. (cont (nthcdr 2 elem)))
  122. (cond
  123. ((eq 'list type)
  124. (omd-set-contents
  125. elem
  126. (dotimes (i nb cont)
  127. (setq cont
  128. (omd-random-insert (omd-random-text (omd-rand 1 3) 30)
  129. cont)))))
  130. ((member type '(headline doc))
  131. (dolist (e cont)
  132. (omd-mutate-doc-list e nb)))))
  133. elem)
  134. (defun omd-shuffle-elem (elem &optional recurse)
  135. "Shuffle the order of the contents of ELEM."
  136. (when (listp elem)
  137. (let ((cont
  138. (map 'list 'identity
  139. (shuffle-vector
  140. (map 'vector 'identity (omd-get-contents elem))))))
  141. (omd-set-contents elem cont)
  142. (when recurse
  143. (dolist (e cont)
  144. (omd-shuffle-elem e)))
  145. elem)))
  146. (defun omd-test ()
  147. ;; original doc is 2 headlines with a list
  148. (let* ((doc-orig (omd-new-doc
  149. (omd-random-headline
  150. (omd-random-list))
  151. (omd-random-headline)))
  152. (doc-a (omd-copy doc-orig))
  153. (doc-b (omd-copy doc-orig)))
  154. ;; doc A adds 2 items to the list
  155. (omd-add-contents
  156. (car (omd-get-contents (car (omd-get-contents doc-a))))
  157. "new item 1"
  158. "new item 2")
  159. ;; doc B adds a new subheadline with a list
  160. (omd-add-contents
  161. (second (omd-get-contents doc-b))
  162. (omd-random-headline
  163. (omd-random-list)))
  164. (with-current-buffer (get-buffer-create "omd test")
  165. (erase-buffer)
  166. (insert
  167. (omd-to-string doc-orig)
  168. "\n\n"
  169. (omd-to-string doc-a)
  170. "\n\n"
  171. (omd-to-string doc-b)))))