~bzg/org-sync

org-sync/omd.el -rw-r--r-- 5.6 KiB
81406cacBastien Add a LICENSE 9 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
;; omd.el --- org-merge-driver document generator

(defconst omd-bullet-type '("+" "-" "num"))

(defun omd-rand (min max)
  "Return random integer in [MIN;MAX[."
  (if (< max min)
      (rotatef min max))
  (let ((d (- max min)))
    (+ min (random d))))

(defun omd-random-word (&optional length)
  "Return random word."
  (unless length
    (setq length (omd-rand 2 7)))

  (let (chars)
    (apply 'string
           (dotimes (i length chars)
             (push (omd-rand 97 123) chars)))))

(defun omd-random-text (&optional lines length prefix)
  "Return random text.
The text has LINES lines and each line is approximately LENGTH
characters."
  (unless prefix
    (setq prefix ""))
  (unless length
    (setq length 70))
  (unless lines
    (setq lines 1))

  (let (text)
    (dotimes (n lines text)
      (if (/= n 0)
          (setq text (concat text "\n" prefix)))

      (let (line)
        (while (< (length line) length)
          (let ((w (omd-random-word)))
            (setq line (if line (concat line " " w) w))))
        (setq text (concat text line))))))


(defun omd-random-paragraph (&optional text)
  (unless text
    (setq text (omd-random-text (omd-rand 2 5))))
  `(paragraph nil ,text))

(defun omd-random-headline (&rest contents)
  (let ((title (omd-random-text 1 20)))
  `(headline (:title ,title) ,@contents)))

(defun omd-pick-random-element (list)
  (let ((len (length list)))
    (nth (omd-rand 0 len) list)))

(defun omd-random-list (&optional nitems bullet)
  (unless nitems
    (setq nitems (omd-rand 2 5)))
  (unless bullet
    (setq bullet (omd-pick-random-element omd-bullet-type)))

  (let* (items)
    (dotimes (i nitems)
      (push (omd-random-text (omd-rand 2 5) 30) items))

    `(list (:bullet ,bullet) ,@items)))


(defun omd-set-contents (elem contents)
  (setf (nthcdr 2 elem) contents))

(defun omd-get-contents (elem)
  (nthcdr 2 elem))

(defun omd-add-contents (elem &rest contents)
  (setcdr (last elem) contents))

(defun omd-get-prop (prop elem)
  (plist-get (nth 1 elem) prop))

(defun omd-set-prop (prop val elem)
  (setcar (cdr elem) (plist-put (nth 1 elem) prop val)))

(defalias 'omd-copy 'copy-tree)

(defun omd-new-doc (&rest contents)
  `(doc () ,@contents))

(defun omd-to-string (elem &optional level)
  (unless level
    (setq level 1))
  (let* ((type (nth 0 elem))
         (prop (nth 1 elem))
         (cont (nthcdr 2 elem)))

    (cond
     ((eq 'doc type)
      (mapconcat 'omd-to-string cont ""))

     ((eq 'headline type)
      (apply 'concat
             (make-string level ?*)
             " "
             (omd-get-prop :title elem)
             "\n"
             (mapcar (lambda (e)
                       (omd-to-string e (1+ level)))
                     cont)))

     ((eq 'list type)
      (let ((n 0)
            (bullet (omd-get-prop :bullet elem)))
        (apply 'concat
              (mapcar (lambda (item)
                        (incf n)
                        (let* ((prefix (if (string= "num" bullet)
                                           (format "%d. " n)
                                         (concat bullet " ")))
                               (space (make-string (length prefix) ?\ ))
                               (replace (concat "\n" space "\\1")))
                          (concat
                           prefix
                           (replace-regexp-in-string "\n\\(.\\)" replace item)
                           "\n")))
                      cont))))

      ((eq 'paragraph type)
       (apply 'concat cont)))))

(defun omd-write-to-file (elem file)
  (with-temp-file file
    (insert (omd-to-string string))))

(defun omd-random-insert (elem list)
  "Insert ELEM in LIST at a random position."
  (let* ((pos (omd-rand 0 (length list))))
    (if (= pos 0)
        (cons elem list)
      (let ((cell (nthcdr (1- pos) list)))
        (setcdr cell
                (cons elem (cdr cell))))
      list)))

(defun omd-mutate-elem-list (elem &optional nb)
  "Append NB items at random positions in every list of ELEM."
  (unless nb
    (setq nb 1))
  (let* ((type (nth 0 elem))
         (cont (nthcdr 2 elem)))
    (cond
     ((eq 'list type)
      (omd-set-contents
       elem
       (dotimes (i nb cont)
         (setq cont
               (omd-random-insert (omd-random-text (omd-rand 1 3) 30)
                                  cont)))))

     ((member type '(headline doc))
      (dolist (e cont)
        (omd-mutate-doc-list e nb)))))
  elem)


(defun omd-shuffle-elem (elem &optional recurse)
  "Shuffle the order of the contents of ELEM."
  (when (listp elem)
    (let ((cont
           (map 'list 'identity
                (shuffle-vector
                 (map 'vector 'identity (omd-get-contents elem))))))
      (omd-set-contents elem cont)
      (when recurse
        (dolist (e cont)
          (omd-shuffle-elem e)))
      elem)))

(defun omd-test ()
  ;; original doc is 2 headlines with a list
  (let* ((doc-orig (omd-new-doc
                    (omd-random-headline
                     (omd-random-list))
                    (omd-random-headline)))

         (doc-a (omd-copy doc-orig))
         (doc-b (omd-copy doc-orig)))

    ;; doc A adds 2 items to the list
    (omd-add-contents
     (car (omd-get-contents (car (omd-get-contents doc-a))))
     "new item 1"
     "new item 2")

    ;; doc B adds a new subheadline with a list
    (omd-add-contents
     (second (omd-get-contents doc-b))
     (omd-random-headline
      (omd-random-list)))

    (with-current-buffer (get-buffer-create "omd test")
      (erase-buffer)
      (insert
       (omd-to-string doc-orig)
       "\n\n"
       (omd-to-string doc-a)
       "\n\n"
       (omd-to-string doc-b)))))